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 119 by tony, Mon Jan 22 13:58:18 2018 UTC

#	Line 27 | Line 27
27		unit FBAttachment;
28		{$IFDEF MSWINDOWS}
29		{$DEFINE WINDOWS}
30	+	{$IF defined(CompilerVersion) and (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	+	begin
369	+	FDPB := FFirebirdAPI.AllocateDPB;
370	+	if FCharSetID > 0 then
371	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
372	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
373	+	end;
374	+	{$ENDIF}
375	+
376		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
377		params: array of const);
378		var i: integer;
#	Line 277 | Line 385 | begin
385		case params[i].vtype of
386		vtinteger    :
387		SQLParams[i].AsInteger := params[i].vinteger;
388	+	vtInt64:
389	+	SQLParams[i].AsInt64 := params[i].VInt64^;
390	+	{$IF declared (vtQWord)}
391	+	vtQWord:
392	+	SQLParams[i].AsInt64 := params[i].VQWord^;
393	+	{$IFEND}
394		vtboolean    :
395		SQLParams[i].AsBoolean :=  params[i].vboolean;
396		vtchar       :
#	Line 286 | Line 400 | begin
400		vtCurrency:
401		SQLParams[i].AsDouble := params[i].VCurrency^;
402		vtString     :
403	<	SQLParams[i].AsString := params[i].VString^;
403	>	SQLParams[i].AsString := strpas(PChar(params[i].VString));
404		vtPChar      :
405		SQLParams[i].AsString := strpas(params[i].VPChar);
406		vtAnsiString :
407	<	SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
407	>	SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
408		vtVariant:
409		SQLParams[i].AsVariant := params[i].VVariant^;
410	+	vtWideChar:
411	+	SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
412	+	vtPWideChar:
413	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
414	+	vtWideString:
415	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
416	+	vtUnicodeString:
417	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
418		else
419		IBError(ibxeInvalidVariantType,[nil]);
420		end;
#	Line 334 | Line 456 | end;
456		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
457		SQLDialect: integer; params: array of const): IResults;
458		begin
459	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
459	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
460		end;
461
462		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 463 | Line 585 | begin
585		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
586		end;
587
588	+	function TFBAttachment.GetConnectString: AnsiString;
589	+	begin
590	+	Result := FDatabaseName;
591	+	end;
592	+
593	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
594	+	begin
595	+	Result := FRemoteProtocol;
596	+	end;
597	+
598	+	function TFBAttachment.GetODSMajorVersion: integer;
599	+	begin
600	+	Result := FODSMajorVersion;
601	+	end;
602	+
603	+	function TFBAttachment.GetODSMinorVersion: integer;
604	+	begin
605	+	Result := FODSMinorVersion;
606	+	end;
607	+
608	+	function TFBAttachment.HasDefaultCharSet: boolean;
609	+	begin
610	+	Result := FHasDefaultCharSet
611	+	end;
612	+
613	+	function TFBAttachment.GetDefaultCharSetID: integer;
614	+	begin
615	+	Result := FCharsetID;
616	+	end;
617	+
618		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
619		var i: integer;
620		begin

Diff Legend

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