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 233 by tony, Mon Apr 16 09:24:40 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
#	Line 54 | Line 55 | type
55		private
56		FDPB: IDPB;
57		FFirebirdAPI: IFirebirdAPI;
58	+	FODSMajorVersion: integer;
59	+	FODSMinorVersion: integer;
60		FUserCharSetMap: array of TCharSetMap;
61	+	FSecDatabase: AnsiString;
62		protected
63		FDatabaseName: AnsiString;
64		FRaiseExceptionOnConnectError: boolean;
#	Line 62 | Line 66 | type
66		FHasDefaultCharSet: boolean;
67		FCharSetID: integer;
68		FCodePage: TSystemCodePage;
69	+	FRemoteProtocol: AnsiString;
70	+	FAuthMethod: AnsiString;
71		constructor Create(DatabaseName: AnsiString; DPB: IDPB;
72		RaiseExceptionOnConnectError: boolean);
73		procedure CheckHandle; virtual; abstract;
74		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
75	+	procedure GetODSAndConnectionInfo;
76	+	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
77	+	function IsConnected: boolean; virtual; abstract;
78		procedure EndAllTransactions;
79	+	procedure DPBFromCreateSQL(CreateSQL: AnsiString);
80		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
81		public
82		destructor Destroy; override;
83		function getDPB: IDPB;
84		function AllocateBPB: IBPB;
85	+	function AllocateDIRB: IDIRB;
86		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
87		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
88		procedure Disconnect(Force: boolean=false); virtual; abstract;
#	Line 113 | Line 124 | type
124		property SQLDialect: integer read FSQLDialect;
125		property DPB: IDPB read FDPB;
126		public
127	<	{Character Sets}
127	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
128	>	function GetDBInformation(Request: byte): IDBInformation; overload;
129	>	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
130	>	function GetConnectString: AnsiString;
131	>	function GetRemoteProtocol: AnsiString;
132	>	function GetAuthenticationMethod: AnsiString;
133	>	function GetSecurityDatabase: AnsiString;
134	>	function GetODSMajorVersion: integer;
135	>	function GetODSMinorVersion: integer;
136	>	{Character Sets}
137	>	function HasDefaultCharSet: boolean;
138	>	function GetDefaultCharSetID: integer;
139		function GetCharsetName(CharSetID: integer): AnsiString;
140		function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
141		function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
#	Line 121 | Line 143 | public
143		function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
144		procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
145		AllowReverseLookup:boolean; out CharSetID: integer);
124	–	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
146		property CharSetID: integer read FCharSetID;
147		property CodePage: TSystemCodePage read FCodePage;
148		end;
149
150		implementation
151
152	<	uses FBMessages, FBTransaction;
152	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
153
154		const
155		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 209 | Line 230 | const
230
231		{ TFBAttachment }
232
233	+	procedure TFBAttachment.GetODSAndConnectionInfo;
234	+	var DBInfo: IDBInformation;
235	+	i: integer;
236	+	Stmt: IStatement;
237	+	ResultSet: IResultSet;
238	+	Param: IDPBItem;
239	+	begin
240	+	if not IsConnected then Exit;
241	+	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
242	+	isc_info_db_SQL_Dialect]);
243	+	for i := 0 to DBInfo.GetCount - 1 do
244	+	with DBInfo[i] do
245	+	case getItemType of
246	+	isc_info_ods_minor_version:
247	+	FODSMinorVersion := getAsInteger;
248	+	isc_info_ods_version:
249	+	FODSMajorVersion := getAsInteger;
250	+	isc_info_db_SQL_Dialect:
251	+	FSQLDialect := getAsInteger;
252	+	end;
253	+
254	+	FCharSetID := 0;
255	+	FRemoteProtocol := '';
256	+	FAuthMethod := 'Legacy_Auth';
257	+	FSecDatabase := 'Default';
258	+	if FODSMajorVersion > 11 then
259	+	begin
260	+	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
261	+	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
262	+	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
263	+	ResultSet := Stmt.OpenCursor;
264	+	if ResultSet.FetchNext then
265	+	begin
266	+	FCharSetID := ResultSet[0].AsInteger;
267	+	FRemoteProtocol := Trim(ResultSet[1].AsString);
268	+	FAuthMethod := Trim(ResultSet[2].AsString);
269	+	FSecDatabase := Trim(ResultSet[3].AsString);
270	+	end
271	+	end
272	+	else
273	+	if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
274	+	begin
275	+	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
276	+	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
277	+	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
278	+	ResultSet := Stmt.OpenCursor;
279	+	if ResultSet.FetchNext then
280	+	begin
281	+	FCharSetID := ResultSet[0].AsInteger;
282	+	FRemoteProtocol := Trim(ResultSet[1].AsString);
283	+	end
284	+	end
285	+	else
286	+	if DPB <> nil then
287	+	begin
288	+	Param :=  DPB.Find(isc_dpb_lc_ctype);
289	+	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
290	+	FCharSetID := 0;
291	+	case GetProtocol(FDatabaseName) of
292	+	TCP:       FRemoteProtocol := 'TCPv4';
293	+	Local:     FRemoteProtocol := '';
294	+	NamedPipe: FRemoteProtocol := 'Netbui';
295	+	SPX:       FRemoteProtocol := 'SPX'
296	+	end;
297	+	end;
298	+	FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
299	+	end;
300	+
301		constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
302		RaiseExceptionOnConnectError: boolean);
303		begin
#	Line 219 | Line 308 | begin
308		FDPB := DPB;
309		SetLength(FUserCharSetMap,0);
310		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
311	+	FODSMajorVersion := 0;
312	+	FODSMinorVersion := 0;
313		end;
314
315		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 265 | Line 356 | begin
356		end;
357		end;
358
359	+	{$IFDEF HASREQEX}
360	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
361	+	var RegexObj: TRegExpr;
362	+	begin
363	+	FDPB := FFirebirdAPI.AllocateDPB;
364	+	RegexObj := TRegExpr.Create;
365	+	try
366	+	{extact database file spec}
367	+	RegexObj.ModifierG := false; {turn off greedy matches}
368	+	RegexObj.ModifierI := true; {case insensitive match}
369	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
370	+	if RegexObj.Exec(CreateSQL) then
371	+	begin
372	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
373	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
374	+	end
375	+	else
376	+	begin
377	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
378	+	if RegexObj.Exec(CreateSQL) then
379	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
380	+	end;
381	+	finally
382	+	RegexObj.Free;
383	+	end;
384	+	if FCharSetID > 0 then
385	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
386	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
387	+	end;
388	+	{$ELSE}
389	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
390	+	begin
391	+	FDPB := FFirebirdAPI.AllocateDPB;
392	+	if FCharSetID > 0 then
393	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
394	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
395	+	end;
396	+	{$ENDIF}
397	+
398		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
399		params: array of const);
400		var i: integer;
#	Line 277 | Line 407 | begin
407		case params[i].vtype of
408		vtinteger    :
409		SQLParams[i].AsInteger := params[i].vinteger;
410	+	vtInt64:
411	+	SQLParams[i].AsInt64 := params[i].VInt64^;
412	+	{$IF declared (vtQWord)}
413	+	vtQWord:
414	+	SQLParams[i].AsInt64 := params[i].VQWord^;
415	+	{$IFEND}
416		vtboolean    :
417		SQLParams[i].AsBoolean :=  params[i].vboolean;
418		vtchar       :
#	Line 286 | Line 422 | begin
422		vtCurrency:
423		SQLParams[i].AsDouble := params[i].VCurrency^;
424		vtString     :
425	<	SQLParams[i].AsString := params[i].VString^;
425	>	SQLParams[i].AsString := strpas(PChar(params[i].VString));
426		vtPChar      :
427		SQLParams[i].AsString := strpas(params[i].VPChar);
428		vtAnsiString :
429	<	SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
429	>	SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
430		vtVariant:
431		SQLParams[i].AsVariant := params[i].VVariant^;
432	+	vtWideChar:
433	+	SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
434	+	vtPWideChar:
435	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
436	+	vtWideString:
437	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
438	+	vtUnicodeString:
439	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
440		else
441		IBError(ibxeInvalidVariantType,[nil]);
442		end;
#	Line 315 | Line 459 | begin
459		Result := TBPB.Create;
460		end;
461
462	+	function TFBAttachment.AllocateDIRB: IDIRB;
463	+	begin
464	+	Result := TDIRB.Create;
465	+	end;
466	+
467		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
468		aSQLDialect: integer);
469		begin
#	Line 334 | Line 483 | end;
483		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
484		SQLDialect: integer; params: array of const): IResults;
485		begin
486	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
486	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
487		end;
488
489		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 463 | Line 612 | begin
612		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
613		end;
614
615	+	function TFBAttachment.GetDBInformation(Requests: array of byte
616	+	): IDBInformation;
617	+	var ReqBuffer: PByte;
618	+	i: integer;
619	+	begin
620	+	CheckHandle;
621	+	if Length(Requests) = 1 then
622	+	Result := GetDBInformation(Requests[0])
623	+	else
624	+	begin
625	+	GetMem(ReqBuffer,Length(Requests));
626	+	try
627	+	for i := 0 to Length(Requests) - 1 do
628	+	ReqBuffer[i] := Requests[i];
629	+
630	+	Result := GetDBInfo(ReqBuffer,Length(Requests));
631	+
632	+	finally
633	+	FreeMem(ReqBuffer);
634	+	end;
635	+	end;
636	+	end;
637	+
638	+	function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
639	+	begin
640	+	CheckHandle;
641	+	Result := GetDBInfo(@Request,1);
642	+	end;
643	+
644	+	function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
645	+	begin
646	+	CheckHandle;
647	+	with Requests as TDIRB do
648	+	Result := GetDBInfo(getBuffer,getDataLength);
649	+	end;
650	+
651	+	function TFBAttachment.GetConnectString: AnsiString;
652	+	begin
653	+	Result := FDatabaseName;
654	+	end;
655	+
656	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
657	+	begin
658	+	Result := FRemoteProtocol;
659	+	end;
660	+
661	+	function TFBAttachment.GetAuthenticationMethod: AnsiString;
662	+	begin
663	+	Result := FAuthMethod;
664	+	end;
665	+
666	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
667	+	begin
668	+	Result := FSecDatabase;
669	+	end;
670	+
671	+	function TFBAttachment.GetODSMajorVersion: integer;
672	+	begin
673	+	Result := FODSMajorVersion;
674	+	end;
675	+
676	+	function TFBAttachment.GetODSMinorVersion: integer;
677	+	begin
678	+	Result := FODSMinorVersion;
679	+	end;
680	+
681	+	function TFBAttachment.HasDefaultCharSet: boolean;
682	+	begin
683	+	Result := FHasDefaultCharSet
684	+	end;
685	+
686	+	function TFBAttachment.GetDefaultCharSetID: integer;
687	+	begin
688	+	Result := FCharsetID;
689	+	end;
690	+
691		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
692		var i: integer;
693		begin
#	Line 532 | Line 757 | var i: integer;
757		begin
758		Result := false;
759		for i := Low(CharSetMap) to High(CharSetMap) do
760	<	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
760	>	if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
761		begin
762		CharSetID := CharSetMap[i].CharSetID;
763		Result := true;
#	Line 540 | Line 765 | begin
765		end;
766
767		for i := 0 to Length(FUserCharSetMap) - 1 do
768	<	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
768	>	if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
769		begin
770		CharSetID := FUserCharSetMap[i].CharSetID;
771		Result := true;

Diff Legend

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