ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/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 118 by tony, Mon Jan 22 13:58:14 2018 UTC

#	Line 27 | Line 27
27		unit FBAttachment;
28		{$IFDEF MSWINDOWS}
29		{$DEFINE WINDOWS}
30	+	{$IF CompilerVersion >= 28}
31	+	{Delphi XE7 onwards}}
32	+	{$define HASREQEX}
33	+	{$IFEND}
34		{$ENDIF}
35
36		{$IFDEF FPC}
37		{$mode delphi}
38		{$interfaces COM}
39	+	{$define HASREQEX}
40		{$ENDIF}
41
42		interface
#	Line 54 | Line 59 | type
59		private
60		FDPB: IDPB;
61		FFirebirdAPI: IFirebirdAPI;
62	+	FODSMajorVersion: integer;
63	+	FODSMinorVersion: integer;
64		FUserCharSetMap: array of TCharSetMap;
65		protected
66		FDatabaseName: AnsiString;
#	Line 62 | Line 69 | type
69		FHasDefaultCharSet: boolean;
70		FCharSetID: integer;
71		FCodePage: TSystemCodePage;
72	+	FRemoteProtocol: AnsiString;
73		constructor Create(DatabaseName: AnsiString; DPB: IDPB;
74		RaiseExceptionOnConnectError: boolean);
75		procedure CheckHandle; virtual; abstract;
76		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
77	+	procedure GetODSAndConnectionInfo;
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;
#	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; virtual; abstract;
128	>	function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
129	>	function GetConnectString: AnsiString;
130	>	function GetRemoteProtocol: AnsiString;
131	>	function GetODSMajorVersion: integer;
132	>	function GetODSMinorVersion: integer;
133	>	{Character Sets}
134	>	function HasDefaultCharSet: boolean;
135	>	function GetDefaultCharSetID: integer;
136		function GetCharsetName(CharSetID: integer): AnsiString;
137		function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
138		function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
#	Line 121 | Line 140 | public
140		function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
141		procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
142		AllowReverseLookup:boolean; out CharSetID: integer);
124	–	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
143		property CharSetID: integer read FCharSetID;
144		property CodePage: TSystemCodePage read FCodePage;
145		end;
146
147		implementation
148
149	<	uses FBMessages, FBTransaction;
149	>	uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
150
151		const
152		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 209 | Line 227 | const
227
228		{ TFBAttachment }
229
230	+	procedure TFBAttachment.GetODSAndConnectionInfo;
231	+	var DBInfo: IDBInformation;
232	+	i: integer;
233	+	Stmt: IStatement;
234	+	ResultSet: IResultSet;
235	+	Param: IDPBItem;
236	+	begin
237	+	if not IsConnected then Exit;
238	+	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
239	+	isc_info_db_SQL_Dialect]);
240	+	for i := 0 to DBInfo.GetCount - 1 do
241	+	with DBInfo[i] do
242	+	case getItemType of
243	+	isc_info_ods_minor_version:
244	+	FODSMinorVersion := getAsInteger;
245	+	isc_info_ods_version:
246	+	FODSMajorVersion := getAsInteger;
247	+	isc_info_db_SQL_Dialect:
248	+	FSQLDialect := getAsInteger;
249	+	end;
250	+
251	+	if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
252	+	begin
253	+	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
254	+	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
255	+	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
256	+	ResultSet := Stmt.OpenCursor;
257	+	if ResultSet.FetchNext then
258	+	begin
259	+	FCharSetID := ResultSet[0].AsInteger;
260	+	FRemoteProtocol := ResultSet[1].AsString;
261	+	end
262	+	end
263	+	else
264	+	if DPB <> nil then
265	+	begin
266	+	Param :=  DPB.Find(isc_dpb_lc_ctype);
267	+	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
268	+	FCharSetID := 0;
269	+	FRemoteProtocol := '';
270	+	end
271	+	else
272	+	begin
273	+	FCharSetID := 0;
274	+	FRemoteProtocol := '';
275	+	end;
276	+	FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
277	+	end;
278	+
279		constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
280		RaiseExceptionOnConnectError: boolean);
281		begin
#	Line 219 | Line 286 | begin
286		FDPB := DPB;
287		SetLength(FUserCharSetMap,0);
288		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
289	+	FODSMajorVersion := 0;
290	+	FODSMinorVersion := 0;
291		end;
292
293		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 265 | Line 334 | begin
334		end;
335		end;
336
337	+	{$IFDEF HASREQEX}
338	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
339	+	var RegexObj: TRegExpr;
340	+	begin
341	+	FDPB := FFirebirdAPI.AllocateDPB;
342	+	RegexObj := TRegExpr.Create;
343	+	try
344	+	{extact database file spec}
345	+	RegexObj.ModifierG := false; {turn off greedy matches}
346	+	RegexObj.ModifierI := true; {case insensitive match}
347	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
348	+	if RegexObj.Exec(CreateSQL) then
349	+	begin
350	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
351	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
352	+	end
353	+	else
354	+	begin
355	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
356	+	if RegexObj.Exec(CreateSQL) then
357	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
358	+	end;
359	+	finally
360	+	RegexObj.Free;
361	+	end;
362	+	if FCharSetID > 0 then
363	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
364	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
365	+	end;
366	+	{$ELSE}
367	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
368	+	end;
369	+	{$ENDIF}
370	+
371		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
372		params: array of const);
373		var i: integer;
#	Line 277 | Line 380 | begin
380		case params[i].vtype of
381		vtinteger    :
382		SQLParams[i].AsInteger := params[i].vinteger;
383	+	vtInt64:
384	+	SQLParams[i].AsInt64 := params[i].VInt64^;
385	+	{$IF declared (vtQWord)}
386	+	vtQWord:
387	+	SQLParams[i].AsInt64 := params[i].VQWord^;
388	+	{$IFEND}
389		vtboolean    :
390		SQLParams[i].AsBoolean :=  params[i].vboolean;
391		vtchar       :
#	Line 286 | Line 395 | begin
395		vtCurrency:
396		SQLParams[i].AsDouble := params[i].VCurrency^;
397		vtString     :
398	<	SQLParams[i].AsString := params[i].VString^;
398	>	SQLParams[i].AsString := strpas(PChar(params[i].VString));
399		vtPChar      :
400		SQLParams[i].AsString := strpas(params[i].VPChar);
401		vtAnsiString :
402	<	SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
402	>	SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
403		vtVariant:
404		SQLParams[i].AsVariant := params[i].VVariant^;
405	+	vtWideChar:
406	+	SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
407	+	vtPWideChar:
408	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
409	+	vtWideString:
410	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
411	+	vtUnicodeString:
412	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
413		else
414		IBError(ibxeInvalidVariantType,[nil]);
415		end;
#	Line 334 | Line 451 | end;
451		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
452		SQLDialect: integer; params: array of const): IResults;
453		begin
454	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
454	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
455		end;
456
457		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 463 | Line 580 | begin
580		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
581		end;
582
583	+	function TFBAttachment.GetConnectString: AnsiString;
584	+	begin
585	+	Result := FDatabaseName;
586	+	end;
587	+
588	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
589	+	begin
590	+	Result := FRemoteProtocol;
591	+	end;
592	+
593	+	function TFBAttachment.GetODSMajorVersion: integer;
594	+	begin
595	+	Result := FODSMajorVersion;
596	+	end;
597	+
598	+	function TFBAttachment.GetODSMinorVersion: integer;
599	+	begin
600	+	Result := FODSMinorVersion;
601	+	end;
602	+
603	+	function TFBAttachment.HasDefaultCharSet: boolean;
604	+	begin
605	+	Result := FHasDefaultCharSet
606	+	end;
607	+
608	+	function TFBAttachment.GetDefaultCharSetID: integer;
609	+	begin
610	+	Result := FCharsetID;
611	+	end;
612	+
613		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
614		var i: integer;
615		begin

Diff Legend

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