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 70 by tony, Thu Oct 26 12:59:51 2017 UTC vs.
Revision 117 by tony, Mon Jan 22 13:58:11 2018 UTC

#	Line 54 | Line 54 | type
54		private
55		FDPB: IDPB;
56		FFirebirdAPI: IFirebirdAPI;
57	+	FODSMajorVersion: integer;
58	+	FODSMinorVersion: integer;
59		FUserCharSetMap: array of TCharSetMap;
60		protected
61		FDatabaseName: AnsiString;
#	Line 62 | Line 64 | type
64		FHasDefaultCharSet: boolean;
65		FCharSetID: integer;
66		FCodePage: TSystemCodePage;
67	+	FRemoteProtocol: AnsiString;
68		constructor Create(DatabaseName: AnsiString; DPB: IDPB;
69		RaiseExceptionOnConnectError: boolean);
70		procedure CheckHandle; virtual; abstract;
71		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
72	+	procedure GetODSAndConnectionInfo;
73	+	function IsConnected: boolean; virtual; abstract;
74		procedure EndAllTransactions;
75	+	procedure DPBFromCreateSQL(CreateSQL: AnsiString);
76		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
77		public
78		destructor Destroy; override;
#	Line 113 | Line 119 | type
119		property SQLDialect: integer read FSQLDialect;
120		property DPB: IDPB read FDPB;
121		public
122	<	{Character Sets}
122	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
123	>	function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
124	>	function GetConnectString: AnsiString;
125	>	function GetRemoteProtocol: AnsiString;
126	>	function GetODSMajorVersion: integer;
127	>	function GetODSMinorVersion: integer;
128	>	{Character Sets}
129	>	function HasDefaultCharSet: boolean;
130	>	function GetDefaultCharSetID: integer;
131		function GetCharsetName(CharSetID: integer): AnsiString;
132		function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
133		function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
#	Line 121 | Line 135 | public
135		function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
136		procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
137		AllowReverseLookup:boolean; out CharSetID: integer);
124	–	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
138		property CharSetID: integer read FCharSetID;
139		property CodePage: TSystemCodePage read FCodePage;
140		end;
141
142		implementation
143
144	<	uses FBMessages, FBTransaction;
144	>	uses FBMessages, FBTransaction, RegExpr;
145
146		const
147		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 209 | Line 222 | const
222
223		{ TFBAttachment }
224
225	+	procedure TFBAttachment.GetODSAndConnectionInfo;
226	+	var DBInfo: IDBInformation;
227	+	i: integer;
228	+	Stmt: IStatement;
229	+	ResultSet: IResultSet;
230	+	Param: IDPBItem;
231	+	begin
232	+	if not IsConnected then Exit;
233	+	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
234	+	isc_info_db_SQL_Dialect]);
235	+	for i := 0 to DBInfo.GetCount - 1 do
236	+	with DBInfo[i] do
237	+	case getItemType of
238	+	isc_info_ods_minor_version:
239	+	FODSMinorVersion := getAsInteger;
240	+	isc_info_ods_version:
241	+	FODSMajorVersion := getAsInteger;
242	+	isc_info_db_SQL_Dialect:
243	+	FSQLDialect := getAsInteger;
244	+	end;
245	+
246	+	if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
247	+	begin
248	+	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
249	+	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
250	+	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
251	+	ResultSet := Stmt.OpenCursor;
252	+	if ResultSet.FetchNext then
253	+	begin
254	+	FCharSetID := ResultSet[0].AsInteger;
255	+	FRemoteProtocol := ResultSet[1].AsString;
256	+	end
257	+	end
258	+	else
259	+	if DPB <> nil then
260	+	begin
261	+	Param :=  DPB.Find(isc_dpb_lc_ctype);
262	+	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
263	+	FCharSetID := 0;
264	+	FRemoteProtocol := '';
265	+	end
266	+	else
267	+	begin
268	+	FCharSetID := 0;
269	+	FRemoteProtocol := '';
270	+	end;
271	+	FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
272	+	end;
273	+
274		constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
275		RaiseExceptionOnConnectError: boolean);
276		begin
#	Line 219 | Line 281 | begin
281		FDPB := DPB;
282		SetLength(FUserCharSetMap,0);
283		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
284	+	FODSMajorVersion := 0;
285	+	FODSMinorVersion := 0;
286		end;
287
288		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 265 | Line 329 | begin
329		end;
330		end;
331
332	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
333	+	var RegexObj: TRegExpr;
334	+	begin
335	+	FDPB := FFirebirdAPI.AllocateDPB;
336	+	RegexObj := TRegExpr.Create;
337	+	try
338	+	{extact database file spec}
339	+	RegexObj.ModifierG := false; {turn off greedy matches}
340	+	RegexObj.ModifierI := true; {case insensitive match}
341	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
342	+	if RegexObj.Exec(CreateSQL) then
343	+	begin
344	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
345	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
346	+	end
347	+	else
348	+	begin
349	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
350	+	if RegexObj.Exec(CreateSQL) then
351	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
352	+	end;
353	+	finally
354	+	RegexObj.Free;
355	+	end;
356	+	if FCharSetID > 0 then
357	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
358	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
359	+	end;
360	+
361		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
362		params: array of const);
363		var i: integer;
#	Line 348 | Line 441 | end;
441		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
442		SQLDialect: integer; params: array of const): IResults;
443		begin
444	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
444	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
445		end;
446
447		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 477 | Line 570 | begin
570		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
571		end;
572
573	+	function TFBAttachment.GetConnectString: AnsiString;
574	+	begin
575	+	Result := FDatabaseName;
576	+	end;
577	+
578	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
579	+	begin
580	+	Result := FRemoteProtocol;
581	+	end;
582	+
583	+	function TFBAttachment.GetODSMajorVersion: integer;
584	+	begin
585	+	Result := FODSMajorVersion;
586	+	end;
587	+
588	+	function TFBAttachment.GetODSMinorVersion: integer;
589	+	begin
590	+	Result := FODSMinorVersion;
591	+	end;
592	+
593	+	function TFBAttachment.HasDefaultCharSet: boolean;
594	+	begin
595	+	Result := FHasDefaultCharSet
596	+	end;
597	+
598	+	function TFBAttachment.GetDefaultCharSetID: integer;
599	+	begin
600	+	Result := FCharsetID;
601	+	end;
602	+
603		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
604		var i: integer;
605		begin

Diff Legend

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