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

Diff Legend

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