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.
ibx/branches/journaling/fbintf/client/FBAttachment.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC

#	Line 32 | Line 32 | unit FBAttachment;
32		{$IFDEF FPC}
33		{$mode delphi}
34		{$interfaces COM}
35	+	{$define HASREQEX}
36		{$ENDIF}
37
38		interface
39
40		uses
41	<	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock, FBActivityMonitor;
41	>	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
42	>	FBActivityMonitor, FBClientAPI;
43	>
44	>	const
45	>	DefaultMaxInlineBlobLimit = 8192;
46
47		type
48		TCharsetMap = record
#	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	+	FSecDatabase: AnsiString;
66	+	FInlineBlobLimit: integer;
67		protected
68		FDatabaseName: AnsiString;
69		FRaiseExceptionOnConnectError: boolean;
#	Line 62 | Line 71 | type
71		FHasDefaultCharSet: boolean;
72		FCharSetID: integer;
73		FCodePage: TSystemCodePage;
74	<	constructor Create(DatabaseName: AnsiString; DPB: IDPB;
74	>	FRemoteProtocol: AnsiString;
75	>	FAuthMethod: AnsiString;
76	>	constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
77		RaiseExceptionOnConnectError: boolean);
78		procedure CheckHandle; virtual; abstract;
79		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
80	+	procedure GetODSAndConnectionInfo;
81	+	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
82	+	function IsConnected: boolean; virtual; abstract;
83		procedure EndAllTransactions;
84	+	procedure DPBFromCreateSQL(CreateSQL: AnsiString);
85		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
86	+	procedure UseServerICUChanged; virtual;
87		public
88		destructor Destroy; override;
89	+	function getFirebirdAPI: IFirebirdAPI;
90		function getDPB: IDPB;
91		function AllocateBPB: IBPB;
92	+	function AllocateDIRB: IDIRB;
93		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
94		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
95		procedure Disconnect(Force: boolean=false); virtual; abstract;
#	Line 83 | Line 101 | type
101		function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
102		function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
103		function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
104	<	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
104	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
105	>	Scrollable: boolean=false): IResultSet; overload;
106		function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
107		params: array of const): IResultSet; overload;
108	<	function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
108	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
109		function OpenCursor(transaction: ITransaction; sql: AnsiString;
110		params: array of const): IResultSet; overload;
111	<	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
111	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
112	>	params: array of const): IResultSet; overload;
113	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
114	>	params: array of const): IResultSet; overload;
115	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
116	>	Scrollable: boolean=false): IResultSet; overload;
117		function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
118		params: array of const): IResultSet; overload;
119	<	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
119	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
120	>	params: array of const): IResultSet; overload;
121	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
122		function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
123		params: array of const): IResultSet; overload;
124	<	function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
124	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
125	>	params: array of const): IResultSet; overload;
126	>	function OpenCursorAtStart(sql: AnsiString;Scrollable: boolean=false): IResultSet; overload;
127	>	function OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
128	>	params: array of const): IResultSet; overload;
129		function OpenCursorAtStart(sql: AnsiString;
130		params: array of const): IResultSet; overload;
131	<	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
132	<	function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
131	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
132	>	function Prepare(transaction: ITransaction; sql: AnsiString; CursorName: AnsiString=''): IStatement; overload;
133		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
134	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
134	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
135	>	CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
136		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
137	<	GenerateParamNames: boolean=false): IStatement; overload;
137	>	GenerateParamNames: boolean=false;
138	>	CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload;
139		function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
140		function GetEventHandler(Event: AnsiString): IEvents; overload;
141
142		function GetSQLDialect: integer;
143	+	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
144	+	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
145		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
146	+	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
147		function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
148	+	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
149	+	): IArray; overload;
150	+	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
151	+	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
152	+	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
153		property SQLDialect: integer read FSQLDialect;
154		property DPB: IDPB read FDPB;
155	<	public
155	>	public
156	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
157	>	function GetDBInformation(Request: byte): IDBInformation; overload;
158	>	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
159	>	function GetConnectString: AnsiString;
160	>	function GetRemoteProtocol: AnsiString;
161	>	function GetAuthenticationMethod: AnsiString;
162	>	function GetSecurityDatabase: AnsiString;
163	>	function GetODSMajorVersion: integer;
164	>	function GetODSMinorVersion: integer;
165	>	function HasDecFloatSupport: boolean; virtual;
166	>	function GetInlineBlobLimit: integer;
167	>	procedure SetInlineBlobLimit(limit: integer);
168	>	function HasBatchMode: boolean; virtual;
169	>
170	>	public
171		{Character Sets}
172	<	function GetCharsetName(CharSetID: integer): AnsiString;
173	<	function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
174	<	function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
175	<	function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
176	<	function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
177	<	procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
178	<	AllowReverseLookup:boolean; out CharSetID: integer);
179	<	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
180	<	property CharSetID: integer read FCharSetID;
181	<	property CodePage: TSystemCodePage read FCodePage;
172	>	function HasDefaultCharSet: boolean;
173	>	function GetDefaultCharSetID: integer;
174	>	function GetCharsetName(CharSetID: integer): AnsiString;
175	>	function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
176	>	function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
177	>	function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
178	>	function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
179	>	procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
180	>	AllowReverseLookup:boolean; out CharSetID: integer);
181	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
182	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
183	>	property CharSetID: integer read FCharSetID;
184	>	property CodePage: TSystemCodePage read FCodePage;
185	>
186	>	public
187	>	{Time Zone Support}
188	>	function GetTimeZoneServices: ITimeZoneServices; virtual;
189	>	function HasTimeZoneSupport: boolean; virtual;
190	>
191	>	end;
192	>
193	>	{ TDPBItem }
194	>
195	>	TDPBItem = class(TParamBlockItem,IDPBItem)
196	>	public
197	>	function getParamTypeName: AnsiString; override;
198	>	end;
199	>
200	>	{ TDPB }
201	>
202	>	TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
203	>	protected
204	>	function LookupItemType(ParamTypeName: AnsiString): byte; override;
205	>	public
206	>	constructor Create(api: TFBClientAPI);
207	>	function GetParamTypeName(ParamType: byte): Ansistring;
208	>	{$IFDEF FPC}
209	>	function IDPB.GetDPBParamTypeName = GetParamTypeName;
210	>	{$ELSE}
211	>	function GetDPBParamTypeName(ParamType: byte): Ansistring;
212	>	{$ENDIF}
213		end;
214
215		implementation
216
217	<	uses FBMessages, FBTransaction;
217	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
218
219		const
220		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 204 | Line 290 | const
290		(CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936; AllowReverseLookup: true)
291		);
292
293	+	const
294	+	isc_dpb_last_dpb_constant = isc_dpb_decfloat_traps;
295	+
296	+	DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
297	+	'cdd_pathname',
298	+	'allocation',
299	+	'journal',
300	+	'page_size',
301	+	'num_buffers',
302	+	'buffer_length',
303	+	'debug',
304	+	'garbage_collect',
305	+	'verify',
306	+	'sweep',
307	+	'enable_journal',
308	+	'disable_journal',
309	+	'dbkey_scope',
310	+	'number_of_users',
311	+	'trace',
312	+	'no_garbage_collect',
313	+	'damaged',
314	+	'license',
315	+	'sys_user_name',
316	+	'encrypt_key',
317	+	'activate_shadow',
318	+	'sweep_interval',
319	+	'delete_shadow',
320	+	'force_write',
321	+	'begin_log',
322	+	'quit_log',
323	+	'no_reserve',
324	+	'user_name',
325	+	'password',
326	+	'password_enc',
327	+	'sys_user_name_enc',
328	+	'interp',
329	+	'online_dump',
330	+	'old_file_size',
331	+	'old_num_files',
332	+	'old_file',
333	+	'old_start_page',
334	+	'old_start_seqno',
335	+	'old_start_file',
336	+	'drop_walfile',
337	+	'old_dump_id',
338	+	'wal_backup_dir',
339	+	'wal_chkptlen',
340	+	'wal_numbufs',
341	+	'wal_bufsize',
342	+	'wal_grp_cmt_wait',
343	+	'lc_messages',
344	+	'lc_ctype',
345	+	'cache_manager',
346	+	'shutdown',
347	+	'online',
348	+	'shutdown_delay',
349	+	'reserved',
350	+	'overwrite',
351	+	'sec_attach',
352	+	'disable_wal',
353	+	'connect_timeout',
354	+	'dummy_packet_interval',
355	+	'gbak_attach',
356	+	'sql_role_name',
357	+	'set_page_buffers',
358	+	'working_directory',
359	+	'sql_dialect',
360	+	'set_db_readonly',
361	+	'set_db_sql_dialect',
362	+	'gfix_attach',
363	+	'gstat_attach',
364	+	'set_db_charset',
365	+	'gsec_attach',
366	+	'address_path' ,
367	+	'process_id',
368	+	'no_db_triggers',
369	+	'trusted_auth',
370	+	'process_name',
371	+	'trusted_role',
372	+	'org_filename',
373	+	'utf8_ilename',
374	+	'ext_call_depth',
375	+	'auth_block',
376	+	'client_version',
377	+	'remote_protocol',
378	+	'host_name',
379	+	'os_user',
380	+	'specific_auth_data',
381	+	'auth_plugin_list',
382	+	'auth_plugin_name',
383	+	'config',
384	+	'nolinger',
385	+	'reset_icu',
386	+	'map_attach',
387	+	'session_time_zone',
388	+	'set_db_replica',
389	+	'set_bind',
390	+	'decfloat_round',
391	+	'decfloat_traps'
392	+	);
393
394
395
396		{ TFBAttachment }
397
398	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
399	<	RaiseExceptionOnConnectError: boolean);
398	>	procedure TFBAttachment.GetODSAndConnectionInfo;
399	>	var DBInfo: IDBInformation;
400	>	i: integer;
401	>	Stmt: IStatement;
402	>	ResultSet: IResultSet;
403	>	Param: IDPBItem;
404	>	begin
405	>	if not IsConnected then Exit;
406	>	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
407	>	isc_info_db_SQL_Dialect]);
408	>	for i := 0 to DBInfo.GetCount - 1 do
409	>	with DBInfo[i] do
410	>	case getItemType of
411	>	isc_info_ods_minor_version:
412	>	FODSMinorVersion := getAsInteger;
413	>	isc_info_ods_version:
414	>	FODSMajorVersion := getAsInteger;
415	>	isc_info_db_SQL_Dialect:
416	>	FSQLDialect := getAsInteger;
417	>	end;
418	>
419	>	FCharSetID := 0;
420	>	FRemoteProtocol := '';
421	>	FAuthMethod := 'Legacy_Auth';
422	>	FSecDatabase := 'Default';
423	>	if FODSMajorVersion > 11 then
424	>	begin
425	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
426	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
427	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION ');
428	>	ResultSet := Stmt.OpenCursor;
429	>	if ResultSet.FetchNext then
430	>	begin
431	>	FCharSetID := ResultSet[0].AsInteger;
432	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
433	>	FAuthMethod := Trim(ResultSet[2].AsString);
434	>	FSecDatabase := Trim(ResultSet[3].AsString);
435	>	end
436	>	end
437	>	else
438	>	if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
439	>	begin
440	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
441	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
442	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
443	>	ResultSet := Stmt.OpenCursor;
444	>	if ResultSet.FetchNext then
445	>	begin
446	>	FCharSetID := ResultSet[0].AsInteger;
447	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
448	>	end
449	>	end
450	>	else
451	>	if DPB <> nil then
452	>	begin
453	>	Param :=  DPB.Find(isc_dpb_lc_ctype);
454	>	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
455	>	FCharSetID := 0;
456	>	case GetProtocol(FDatabaseName) of
457	>	TCP:       FRemoteProtocol := 'TCPv4';
458	>	Local:     FRemoteProtocol := '';
459	>	NamedPipe: FRemoteProtocol := 'Netbui';
460	>	SPX:       FRemoteProtocol := 'SPX'
461	>	end;
462	>	end;
463	>	FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
464	>	end;
465	>
466	>	constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
467	>	DPB: IDPB; RaiseExceptionOnConnectError: boolean);
468		begin
469		inherited Create;
470	<	FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
470	>	FFirebirdAPI := api.GetAPI; {Keep reference to interface}
471		FSQLDialect := 3;
472		FDatabaseName := DatabaseName;
473		FDPB := DPB;
474		SetLength(FUserCharSetMap,0);
475		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
476	+	FODSMajorVersion := 0;
477	+	FODSMinorVersion := 0;
478	+	FInlineBlobLimit := DefaultMaxInlineBlobLimit;
479		end;
480
481		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 265 | Line 522 | begin
522		end;
523		end;
524
525	+	{$IFDEF HASREQEX}
526	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
527	+	var RegexObj: TRegExpr;
528	+	begin
529	+	FDPB := FFirebirdAPI.AllocateDPB;
530	+	RegexObj := TRegExpr.Create;
531	+	try
532	+	{extact database file spec}
533	+	RegexObj.ModifierG := false; {turn off greedy matches}
534	+	RegexObj.ModifierI := true; {case insensitive match}
535	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
536	+	if RegexObj.Exec(CreateSQL) then
537	+	begin
538	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
539	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
540	+	end
541	+	else
542	+	begin
543	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
544	+	if RegexObj.Exec(CreateSQL) then
545	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
546	+	end;
547	+	finally
548	+	RegexObj.Free;
549	+	end;
550	+	if FCharSetID > 0 then
551	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
552	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
553	+	end;
554	+	{$ELSE}
555	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
556	+	begin
557	+	FDPB := FFirebirdAPI.AllocateDPB;
558	+	if FCharSetID > 0 then
559	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
560	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
561	+	end;
562	+	{$ENDIF}
563	+
564		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
565		params: array of const);
566		var i: integer;
#	Line 277 | Line 573 | begin
573		case params[i].vtype of
574		vtinteger    :
575		SQLParams[i].AsInteger := params[i].vinteger;
576	+	vtInt64:
577	+	SQLParams[i].AsInt64 := params[i].VInt64^;
578	+	{$IF declared (vtQWord)}
579	+	vtQWord:
580	+	SQLParams[i].AsInt64 := params[i].VQWord^;
581	+	{$IFEND}
582		vtboolean    :
583		SQLParams[i].AsBoolean :=  params[i].vboolean;
584		vtchar       :
#	Line 286 | Line 588 | begin
588		vtCurrency:
589		SQLParams[i].AsDouble := params[i].VCurrency^;
590		vtString     :
591	<	SQLParams[i].AsString := params[i].VString^;
591	>	SQLParams[i].AsString := strpas(PChar(params[i].VString));
592		vtPChar      :
593		SQLParams[i].AsString := strpas(params[i].VPChar);
594		vtAnsiString :
595	<	SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
595	>	SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
596		vtVariant:
597		SQLParams[i].AsVariant := params[i].VVariant^;
598	+	vtWideChar:
599	+	SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
600	+	vtPWideChar:
601	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
602	+	vtWideString:
603	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
604	+	vtUnicodeString:
605	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
606		else
607		IBError(ibxeInvalidVariantType,[nil]);
608		end;
609		end;
610		end;
611
612	+	procedure TFBAttachment.UseServerICUChanged;
613	+	begin
614	+	// Do nothing by default
615	+	end;
616	+
617		destructor TFBAttachment.Destroy;
618		begin
619		Disconnect(true);
620		inherited Destroy;
621		end;
622
623	+	function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
624	+	begin
625	+	Result := FFirebirdAPI;
626	+	end;
627	+
628		function TFBAttachment.getDPB: IDPB;
629		begin
630		Result := FDPB;
#	Line 312 | Line 632 | end;
632
633		function TFBAttachment.AllocateBPB: IBPB;
634		begin
635	<	Result := TBPB.Create;
635	>	Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
636	>	end;
637	>
638	>	function TFBAttachment.AllocateDIRB: IDIRB;
639	>	begin
640	>	Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
641		end;
642
643		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
#	Line 334 | Line 659 | end;
659		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
660		SQLDialect: integer; params: array of const): IResults;
661		begin
662	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
662	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
663		end;
664
665		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 364 | Line 689 | begin
689		end;
690
691		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
692	<	aSQLDialect: integer): IResultSet;
692	>	aSQLDialect: integer; Scrollable: boolean): IResultSet;
693		begin
694	<	Result := OpenCursor(transaction,sql,aSQLDialect,[]);
694	>	Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
695		end;
696
697		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
698		aSQLDialect: integer; params: array of const): IResultSet;
699	<	var Statement: IStatement;
699	>
700		begin
701	<	CheckHandle;
377	<	Statement := Prepare(transaction,sql,aSQLDialect);
378	<	SetParameters(Statement.SQLParams,params);
379	<	Result := Statement.OpenCursor;
701	>	Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
702		end;
703
704	<	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
705	<	): IResultSet;
704	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
705	>	Scrollable: boolean): IResultSet;
706		begin
707	<	Result := OpenCursor(transaction,sql,FSQLDialect,[]);
707	>	Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,[]);
708		end;
709
710		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
711		params: array of const): IResultSet;
712		begin
713	<	Result := OpenCursor(transaction,sql,FSQLDialect,params);
713	>	Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
714	>	end;
715	>
716	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
717	>	Scrollable: boolean; params: array of const): IResultSet;
718	>	begin
719	>	Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,params);
720	>	end;
721	>
722	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
723	>	aSQLDialect: integer; Scrollable: boolean;
724	>	params: array of const): IResultSet;
725	>	var Statement: IStatement;
726	>	begin
727	>	CheckHandle;
728	>	Statement := Prepare(transaction,sql,aSQLDialect);
729	>	SetParameters(Statement.SQLParams,params);
730	>	Result := Statement.OpenCursor(Scrollable);
731		end;
732
733		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
734	<	sql: AnsiString; aSQLDialect: integer): IResultSet;
734	>	sql: AnsiString; aSQLDialect: integer; Scrollable: boolean): IResultSet;
735		begin
736	<	Result := OpenCursor(transaction,sql,aSQLDialect,[]);
736	>	Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
737		Result.FetchNext;
738		end;
739
#	Line 405 | Line 744 | begin
744		Result.FetchNext;
745		end;
746
747	<	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
748	<	): IResultSet;
747	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
748	>	sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
749	>	params: array of const): IResultSet;
750		begin
751	<	Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
751	>	Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,params);
752	>	Result.FetchNext;
753	>	end;
754	>
755	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
756	>	sql: AnsiString; Scrollable: boolean): IResultSet;
757	>	begin
758	>	Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,[]);
759		end;
760
761		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
#	Line 417 | Line 764 | begin
764		Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
765		end;
766
767	<	function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
767	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
768	>	sql: AnsiString; Scrollable: boolean; params: array of const): IResultSet;
769	>	begin
770	>	Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,params);
771	>	end;
772	>
773	>	function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean
774	>	): IResultSet;
775		begin
776	<	Result := OpenCursorAtStart(sql,[]);
776	>	Result := OpenCursorAtStart(sql,Scrollable,[]);
777	>	end;
778	>
779	>	function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
780	>	params: array of const): IResultSet;
781	>	begin
782	>	Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,
783	>	Scrollable,params);
784		end;
785
786		function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
787		params: array of const): IResultSet;
788		begin
789	<	Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
789	>	Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,
790	>	false,params);
791		end;
792
793	<	function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
794	<	): IStatement;
793	>	function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString;
794	>	CursorName: AnsiString): IStatement;
795		begin
796	<	Result := Prepare(transaction,sql,FSQLDialect);
796	>	Result := Prepare(transaction,sql,FSQLDialect,CursorName);
797		end;
798
799		function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
800	<	sql: AnsiString; GenerateParamNames: boolean): IStatement;
800	>	sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean;
801	>	CursorName: AnsiString): IStatement;
802		begin
803	<	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
803	>	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams,CursorName);
804		end;
805
806		function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
#	Line 457 | Line 820 | begin
820		Result := FSQLDialect;
821		end;
822
823	+	function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
824	+	ColumnName: AnsiString; BPB: IBPB): IBlob;
825	+	begin
826	+	Result := CreateBlob(transaction,GetBlobMetaData(Transaction,RelationName,ColumnName),BPB);
827	+	end;
828	+
829	+	function TFBAttachment.OpenBlob(transaction: ITransaction; RelationName,
830	+	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
831	+	begin
832	+	Result := OpenBlob(Transaction,
833	+	GetBlobMetaData(Transaction,RelationName,ColumnName),
834	+	BlobID,BPB);
835	+	end;
836	+
837		function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
838		BPB: IBPB): IBlob;
839		begin
840		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
841		end;
842
843	+	function TFBAttachment.CreateArray(transaction: ITransaction; RelationName,
844	+	ColumnName: AnsiString): IArray;
845	+	begin
846	+	Result := CreateArray(transaction,GetArrayMetaData(transaction,RelationName,ColumnName));
847	+	end;
848	+
849	+	function TFBAttachment.OpenArray(transaction: ITransaction; RelationName,
850	+	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
851	+	begin
852	+	Result := OpenArray(transaction,
853	+	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
854	+	end;
855	+
856	+	function TFBAttachment.GetDBInformation(Requests: array of byte
857	+	): IDBInformation;
858	+	var ReqBuffer: PByte;
859	+	i: integer;
860	+	begin
861	+	CheckHandle;
862	+	if Length(Requests) = 1 then
863	+	Result := GetDBInformation(Requests[0])
864	+	else
865	+	begin
866	+	GetMem(ReqBuffer,Length(Requests));
867	+	try
868	+	for i := 0 to Length(Requests) - 1 do
869	+	ReqBuffer[i] := Requests[i];
870	+
871	+	Result := GetDBInfo(ReqBuffer,Length(Requests));
872	+
873	+	finally
874	+	FreeMem(ReqBuffer);
875	+	end;
876	+	end;
877	+	end;
878	+
879	+	function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
880	+	begin
881	+	CheckHandle;
882	+	Result := GetDBInfo(@Request,1);
883	+	end;
884	+
885	+	function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
886	+	begin
887	+	CheckHandle;
888	+	with Requests as TDIRB do
889	+	Result := GetDBInfo(getBuffer,getDataLength);
890	+	end;
891	+
892	+	function TFBAttachment.GetConnectString: AnsiString;
893	+	begin
894	+	Result := FDatabaseName;
895	+	end;
896	+
897	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
898	+	begin
899	+	Result := FRemoteProtocol;
900	+	end;
901	+
902	+	function TFBAttachment.GetAuthenticationMethod: AnsiString;
903	+	begin
904	+	Result := FAuthMethod;
905	+	end;
906	+
907	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
908	+	begin
909	+	Result := FSecDatabase;
910	+	end;
911	+
912	+	function TFBAttachment.GetODSMajorVersion: integer;
913	+	begin
914	+	Result := FODSMajorVersion;
915	+	end;
916	+
917	+	function TFBAttachment.GetODSMinorVersion: integer;
918	+	begin
919	+	Result := FODSMinorVersion;
920	+	end;
921	+
922	+	function TFBAttachment.HasDecFloatSupport: boolean;
923	+	begin
924	+	Result := false;
925	+	end;
926	+
927	+	function TFBAttachment.GetInlineBlobLimit: integer;
928	+	begin
929	+	Result := FInlineBlobLimit;
930	+	end;
931	+
932	+	procedure TFBAttachment.SetInlineBlobLimit(limit: integer);
933	+	begin
934	+	if limit > 32*1024 then
935	+	FInlineBlobLimit := 32*1024
936	+	else
937	+	FInlineBlobLimit := limit;
938	+	end;
939	+
940	+	function TFBAttachment.HasBatchMode: boolean;
941	+	begin
942	+	Result := false;
943	+	end;
944	+
945	+	function TFBAttachment.HasDefaultCharSet: boolean;
946	+	begin
947	+	Result := FHasDefaultCharSet
948	+	end;
949	+
950	+	function TFBAttachment.GetDefaultCharSetID: integer;
951	+	begin
952	+	Result := FCharsetID;
953	+	end;
954	+
955		function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
956		var i: integer;
957		begin
#	Line 532 | Line 1021 | var i: integer;
1021		begin
1022		Result := false;
1023		for i := Low(CharSetMap) to High(CharSetMap) do
1024	<	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
1024	>	if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
1025		begin
1026		CharSetID := CharSetMap[i].CharSetID;
1027		Result := true;
#	Line 540 | Line 1029 | begin
1029		end;
1030
1031		for i := 0 to Length(FUserCharSetMap) - 1 do
1032	<	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
1032	>	if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
1033		begin
1034		CharSetID := FUserCharSetMap[i].CharSetID;
1035		Result := true;
#	Line 597 | Line 1086 | begin
1086		CharSetID := CharSets[0].AsInteger;
1087		end;
1088
1089	+	function TFBAttachment.GetTimeZoneServices: ITimeZoneServices;
1090	+	begin
1091	+	IBError(ibxeNotSupported,[]);
1092	+	end;
1093	+
1094	+	function TFBAttachment.HasTimeZoneSupport: boolean;
1095	+	begin
1096	+	Result := false;
1097	+	end;
1098	+
1099	+	{ TDPBItem }
1100	+
1101	+	function TDPBItem.getParamTypeName: AnsiString;
1102	+	begin
1103	+	Result := DPBPrefix + DPBConstantNames[getParamType];
1104	+	end;
1105	+
1106	+	{ TDPB }
1107	+
1108	+	constructor TDPB.Create(api: TFBClientAPI);
1109	+	begin
1110	+	inherited Create(api);
1111	+	FDataLength := 1;
1112	+	FBuffer^ := isc_dpb_version1;
1113	+	end;
1114	+
1115	+	function TDPB.GetParamTypeName(ParamType: byte): Ansistring;
1116	+	begin
1117	+	if ParamType <= isc_dpb_last_dpb_constant then
1118	+	Result := DPBConstantNames[ParamType]
1119	+	else
1120	+	Result := '';
1121	+	end;
1122	+
1123	+	{$IFNDEF FPC}
1124	+	function TDPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
1125	+	begin
1126	+	Result := GetParamTypeName(ParamType);
1127	+	end;
1128	+	{$ENDIF}
1129	+
1130	+	function TDPB.LookupItemType(ParamTypeName: AnsiString): byte;
1131	+	var i: byte;
1132	+	begin
1133	+	Result := 0;
1134	+	ParamTypeName := LowerCase(ParamTypeName);
1135	+	if (Pos(DPBPrefix, ParamTypeName) = 1) then
1136	+	Delete(ParamTypeName, 1, Length(DPBPrefix));
1137	+
1138	+	for i := 1 to isc_dpb_last_dpb_constant do
1139	+	if (ParamTypeName = DPBConstantNames[i]) then
1140	+	begin
1141	+	Result := i;
1142	+	break;
1143	+	end;
1144	+	end;
1145	+
1146		end.
1147

Diff Legend

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