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

Diff Legend

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