ViewVC Help

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

root/public/ibx/branches/udr/client/3.0/FB30Statement.pas

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents), Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 389 by tony, Thu Jan 20 23:33:40 2022 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FB30Statement;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$codepage UTF8}
35		{$interfaces COM}
36		{$ENDIF}
#	Line 75 | Line 78 | uses
78		FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79
80		type
78	–
81		TFB30Statement = class;
82		TIBXSQLDA = class;
83
#	Line 84 | Line 86 | type
86		TIBXSQLVAR = class(TSQLVarData)
87		private
88		FStatement: TFB30Statement;
89	+	FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob;             {Cache references}
88	–	FArray: IArray;
91		FNullIndicator: short;
92		FOwnsSQLData: boolean;
93		FBlobMetaData: IBlobMetaData;
#	Line 94 | Line 96 | type
96		{SQL Var Type Data}
97		FSQLType: cardinal;
98		FSQLSubType: integer;
99	<	FSQLData: PChar; {Address of SQL Data in Message Buffer}
99	>	FSQLData: PByte; {Address of SQL Data in Message Buffer}
100		FSQLNullIndicator: PShort; {Address of null indicator}
101	<	FDataLength: integer;
101	>	FDataLength: cardinal;
102	>	FMetadataSize: cardinal;
103		FNullable: boolean;
104		FScale: integer;
105		FCharSetID: cardinal;
106	<	FRelationName: string;
107	<	FFieldName: string;
106	>	FRelationName: AnsiString;
107	>	FFieldName: AnsiString;
108
109		protected
110	+	function CanChangeSQLType: boolean;
111		function GetSQLType: cardinal; override;
112		function GetSubtype: integer; override;
113	<	function GetAliasName: string;  override;
114	<	function GetFieldName: string; override;
115	<	function GetOwnerName: string;  override;
116	<	function GetRelationName: string;  override;
113	>	function GetAliasName: AnsiString;  override;
114	>	function GetFieldName: AnsiString; override;
115	>	function GetOwnerName: AnsiString;  override;
116	>	function GetRelationName: AnsiString;  override;
117		function GetScale: integer; override;
118		function GetCharSetID: cardinal; override;
115	–	function GetCodePage: TSystemCodePage; override;
119		function GetIsNull: Boolean;   override;
120		function GetIsNullable: boolean; override;
121	<	function GetSQLData: PChar;  override;
121	>	function GetSQLData: PByte;  override;
122		function GetDataLength: cardinal; override;
123	+	function GetSize: cardinal; override;
124	+	function GetDefaultTextSQLType: cardinal; override;
125		procedure SetIsNull(Value: Boolean); override;
126		procedure SetIsNullable(Value: Boolean);  override;
127	<	procedure SetSQLData(AValue: PChar; len: cardinal); override;
128	<	procedure SetScale(aValue: integer); override;
129	<	procedure SetDataLength(len: cardinal); override;
125	<	procedure SetSQLType(aValue: cardinal); override;
127	>	procedure InternalSetScale(aValue: integer); override;
128	>	procedure InternalSetDataLength(len: cardinal); override;
129	>	procedure InternalSetSQLType(aValue: cardinal); override;
130		procedure SetCharSetID(aValue: cardinal); override;
131	<
131	>	procedure SetMetaSize(aValue: cardinal); override;
132		public
133		constructor Create(aParent: TIBXSQLDA; aIndex: integer);
134		procedure Changed; override;
135	+	procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
136	+	procedure ColumnSQLDataInit;
137		procedure RowChange; override;
138		procedure FreeSQLData;
139	<	function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
139	>	function GetAsArray: IArray; override;
140		function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
141		function GetArrayMetaData: IArrayMetaData; override;
142		function GetBlobMetaData: IBlobMetaData; override;
143		function CreateBlob: IBlob; override;
144	+	procedure SetSQLData(AValue: PByte; len: cardinal); override;
145		end;
146
147		{ TIBXSQLDA }
#	Line 145 | Line 152 | type
152		FSize: Integer;  {Number of TIBXSQLVARs in column list}
153		FMetaData: Firebird.IMessageMetadata;
154		FTransactionSeqNo: integer;
155	<	protected
155	>	protected
156		FStatement: TFB30Statement;
157	+	FFirebird30ClientAPI: TFB30ClientAPI;
158	+	FMessageBuffer: PByte; {Message Buffer}
159	+	FMsgLength: integer; {Message Buffer length}
160		function GetTransactionSeqNo: integer; override;
161		procedure FreeXSQLDA; virtual;
162		function GetStatement: IStatement; override;
163		function GetPrepareSeqNo: integer; override;
164		procedure SetCount(Value: Integer); override;
165	+	procedure AllocMessageBuffer(len: integer); virtual;
166	+	procedure FreeMessageBuffer; virtual;
167		public
168	<	constructor Create(aStatement: TFB30Statement);
168	>	constructor Create(aStatement: TFB30Statement); overload;
169	>	constructor Create(api: IFirebirdAPI); overload;
170		destructor Destroy; override;
171		procedure Changed; virtual;
172		function CheckStatementStatus(Request: TStatementStatus): boolean; override;
173		function ColumnsInUseCount: integer; override;
174	<	function GetTransaction: TFB30Transaction; virtual;
174	>	function GetMetaData: Firebird.IMessageMetadata; virtual;
175		procedure Initialize; override;
176		function StateChanged(var ChangeSeqNo: integer): boolean; override;
177	<	property MetaData: Firebird.IMessageMetadata read FMetaData;
177	>	function CanChangeMetaData: boolean; override;
178		property Count: Integer read FCount write SetCount;
179		property Statement: TFB30Statement read FStatement;
180		end;
#	Line 170 | Line 183 | type
183
184		TIBXINPUTSQLDA = class(TIBXSQLDA)
185		private
173	–	FMessageBuffer: PChar; {Message Buffer}
174	–	FMsgLength: integer; {Message Buffer length}
186		FCurMetaData: Firebird.IMessageMetadata;
187	<	procedure FreeMessageBuffer;
188	<	function GetMessageBuffer: PChar;
178	<	function GetMetaData: Firebird.IMessageMetadata;
187	>	procedure FreeCurMetaData;
188	>	function GetMessageBuffer: PByte;
189		function GetModified: Boolean;
190		function GetMsgLength: integer;
191	<	procedure PackBuffer;
191	>	procedure BuildMetadata;
192		protected
193	+	procedure PackBuffer;
194		procedure FreeXSQLDA; override;
195		public
196	<	constructor Create(aStatement: TFB30Statement);
196	>	constructor Create(aStatement: TFB30Statement); overload;
197	>	constructor Create(api: IFirebirdAPI); overload;
198		destructor Destroy; override;
199		procedure Bind(aMetaData: Firebird.IMessageMetadata);
200		procedure Changed; override;
201	+	function GetMetaData: Firebird.IMessageMetadata; override;
202	+	procedure ReInitialise;
203		function IsInputDataArea: boolean; override;
204	<	property MetaData: Firebird.IMessageMetadata read GetMetaData;
191	<	property MessageBuffer: PChar read GetMessageBuffer;
204	>	property MessageBuffer: PByte read GetMessageBuffer;
205		property MsgLength: integer read GetMsgLength;
206		end;
207
#	Line 197 | Line 210 | type
210		TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211		private
212		FTransaction: TFB30Transaction; {transaction used to execute the statement}
200	–	FMessageBuffer: PChar; {Message Buffer}
201	–	FMsgLength: integer; {Message Buffer length}
213		protected
214	<	procedure FreeXSQLDA; override;
214	>	function GetTransaction: ITransaction; override;
215		public
216		procedure Bind(aMetaData: Firebird.IMessageMetadata);
217		procedure GetData(index: integer; var aIsNull: boolean; var len: short;
218	<	var data: PChar); override;
218	>	var data: PByte); override;
219		function IsInputDataArea: boolean; override;
220	<	property MessageBuffer: PChar read FMessageBuffer;
220	>	property MessageBuffer: PByte read FMessageBuffer;
221		property MsgLength: integer read FMsgLength;
222		end;
223
#	Line 216 | Line 227 | type
227		private
228		FResults: TIBXOUTPUTSQLDA;
229		FCursorSeqNo: integer;
230	+	procedure RowChange;
231		public
232		constructor Create(aResults: TIBXOUTPUTSQLDA);
233		destructor Destroy; override;
234		{IResultSet}
235	<	function FetchNext: boolean;
236	<	function GetCursorName: string;
237	<	function GetTransaction: ITransaction; override;
235	>	function FetchNext: boolean; {fetch next record}
236	>	function FetchPrior: boolean; {fetch previous record}
237	>	function FetchFirst:boolean; {fetch first record}
238	>	function FetchLast: boolean; {fetch last record}
239	>	function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
240	>	function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
241	>	function GetCursorName: AnsiString;
242	>	function IsBof: boolean;
243		function IsEof: boolean;
244		procedure Close;
245		end;
246
247	+	{ TBatchCompletion }
248	+
249	+	TBatchCompletion = class(TInterfaceOwner,IBatchCompletion)
250	+	private
251	+	FCompletionState: Firebird.IBatchCompletionState;
252	+	FFirebird30ClientAPI: TFB30ClientAPI;
253	+	public
254	+	constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
255	+	destructor Destroy; override;
256	+	{IBatchCompletion}
257	+	function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
258	+	function getTotalProcessed: cardinal;
259	+	function getState(updateNo: cardinal): TBatchCompletionState;
260	+	function getStatusMessage(updateNo: cardinal): AnsiString;
261	+	function getUpdated: integer;
262	+	end;
263	+
264	+	TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
265	+
266		{ TFB30Statement }
267
268		TFB30Statement = class(TFBStatement,IStatement)
269		private
270		FStatementIntf: Firebird.IStatement;
271	+	FFirebird30ClientAPI: TFB30ClientAPI;
272		FSQLParams: TIBXINPUTSQLDA;
273		FSQLRecord: TIBXOUTPUTSQLDA;
274		FResultSet: Firebird.IResultSet;
275		FCursorSeqNo: integer;
276	+	FCursor: AnsiString;
277	+	FBatch: Firebird.IBatch;
278	+	FBatchCompletion: IBatchCompletion;
279	+	FBatchRowCount: integer;
280	+	FBatchBufferSize: integer;
281	+	FBatchBufferUsed: integer;
282		protected
283	+	procedure CheckChangeBatchRowLimit; override;
284		procedure CheckHandle; override;
285	+	procedure CheckBatchModeAvailable;
286		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
287	<	procedure InternalPrepare; override;
287	>	function GetStatementIntf: IStatement; override;
288	>	procedure InternalPrepare(CursorName: AnsiString=''); override;
289		function InternalExecute(aTransaction: ITransaction): IResults; override;
290	<	function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
290	>	function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
291	>	): IResultSet; override;
292	>	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
293		procedure FreeHandle; override;
294		procedure InternalClose(Force: boolean); override;
295	+	function SavePerfStats(var Stats: TPerfStatistics): boolean;
296		public
297		constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
298	<	sql: string; aSQLDialect: integer);
298	>	sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
299		constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
300	<	sql: string;  aSQLDialect: integer; GenerateParamNames: boolean =false);
300	>	sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
301	>	CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
302		destructor Destroy; override;
303	<	function FetchNext: boolean;
303	>	function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
304		property StatementIntf: Firebird.IStatement read FStatementIntf;
305	+	property SQLParams: TIBXINPUTSQLDA read FSQLParams;
306	+	property SQLRecord: TIBXOUTPUTSQLDA read FSQLRecord;
307
308		public
309		{IStatement}
310		function GetSQLParams: ISQLParams; override;
311		function GetMetaData: IMetaData; override;
312	<	function GetPlan: String;
312	>	function GetPlan: AnsiString;
313		function IsPrepared: boolean;
314	+	function GetFlags: TStatementFlags; override;
315		function CreateBlob(column: TColumnMetaData): IBlob; override;
316		function CreateArray(column: TColumnMetaData): IArray; override;
317		procedure SetRetainInterfaces(aValue: boolean); override;
318	<
318	>	function IsInBatchMode: boolean; override;
319	>	function HasBatchMode: boolean; override;
320	>	procedure AddToBatch; override;
321	>	function ExecuteBatch(aTransaction: ITransaction
322	>	): IBatchCompletion; override;
323	>	procedure CancelBatch; override;
324	>	function GetBatchCompletion: IBatchCompletion; override;
325		end;
326
327		implementation
328
329	<	uses IBUtils, FBMessages, FBBLob, FB30Blob, variants,  FBArray, FB30Array;
329	>	uses IBUtils, FBMessages, FBBlob, FB30Blob, variants,  FBArray, FB30Array;
330
331		const
332		ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
333
334	+	{ EIBBatchCompletionError }
335	+
336	+	{ TBatchCompletion }
337	+
338	+	constructor TBatchCompletion.Create(api: TFB30ClientAPI;
339	+	cs: IBatchCompletionState);
340	+	begin
341	+	inherited Create;
342	+	FFirebird30ClientAPI := api;
343	+	FCompletionState := cs;
344	+	end;
345	+
346	+	destructor TBatchCompletion.Destroy;
347	+	begin
348	+	if FCompletionState <> nil then
349	+	begin
350	+	FCompletionState.dispose;
351	+	FCompletionState := nil;
352	+	end;
353	+	inherited Destroy;
354	+	end;
355	+
356	+	function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus
357	+	): boolean;
358	+	var i: integer;
359	+	upcount: cardinal;
360	+	state: integer;
361	+	FBStatus: Firebird.IStatus;
362	+	begin
363	+	Result := false;
364	+	RowNo := -1;
365	+	FBStatus := nil;
366	+	with FFirebird30ClientAPI do
367	+	begin
368	+	upcount := FCompletionState.getSize(StatusIntf);
369	+	Check4DataBaseError;
370	+	for i := 0 to upcount - 1 do
371	+	begin
372	+	state := FCompletionState.getState(StatusIntf,i);
373	+	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
374	+	begin
375	+	RowNo := i+1;
376	+	FBStatus := MasterIntf.getStatus;
377	+	try
378	+	FCompletionState.getStatus(StatusIntf,FBStatus,i);
379	+	Check4DataBaseError;
380	+	except
381	+	FBStatus.dispose;
382	+	raise
383	+	end;
384	+	status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
385	+	Format(SBatchCompletionError,[RowNo]));
386	+	status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
387	+	Result := true;
388	+	break;
389	+	end;
390	+	end;
391	+	end;
392	+	end;
393	+
394	+	function TBatchCompletion.getTotalProcessed: cardinal;
395	+	begin
396	+	with FFirebird30ClientAPI do
397	+	begin
398	+	Result := FCompletionState.getsize(StatusIntf);
399	+	Check4DataBaseError;
400	+	end;
401	+	end;
402	+
403	+	function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState;
404	+	var state: integer;
405	+	begin
406	+	with FFirebird30ClientAPI do
407	+	begin
408	+	state := FCompletionState.getState(StatusIntf,updateNo);
409	+	Check4DataBaseError;
410	+	case state of
411	+	Firebird.IBatchCompletionState.EXECUTE_FAILED:
412	+	Result := bcExecuteFailed;
413	+
414	+	Firebird.IBatchCompletionState.SUCCESS_NO_INFO:
415	+	Result := bcSuccessNoInfo;
416	+
417	+	else
418	+	Result := bcNoMoreErrors;
419	+	end;
420	+	end;
421	+	end;
422	+
423	+	function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString;
424	+	var status: Firebird.IStatus;
425	+	begin
426	+	with FFirebird30ClientAPI do
427	+	begin
428	+	status := MasterIntf.getStatus;
429	+	FCompletionState.getStatus(StatusIntf,status,updateNo);
430	+	Check4DataBaseError;
431	+	Result := FormatStatus(status);
432	+	end;
433	+	end;
434	+
435	+	function TBatchCompletion.getUpdated: integer;
436	+	var i: integer;
437	+	upcount: cardinal;
438	+	state: integer;
439	+	begin
440	+	Result := 0;
441	+	with FFirebird30ClientAPI do
442	+	begin
443	+	upcount := FCompletionState.getSize(StatusIntf);
444	+	Check4DataBaseError;
445	+	for i := 0 to upcount -1  do
446	+	begin
447	+	state := FCompletionState.getState(StatusIntf,i);
448	+	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
449	+	break;
450	+	Inc(Result);
451	+	end;
452	+	end;
453	+	end;
454	+
455		{ TIBXSQLVAR }
456
457		procedure TIBXSQLVAR.Changed;
#	Line 280 | Line 460 | begin
460		TIBXSQLDA(Parent).Changed;
461		end;
462
463	+	procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
464	+	begin
465	+	with FFirebird30ClientAPI do
466	+	begin
467	+	FSQLType := aMetaData.getType(StatusIntf,Index);
468	+	Check4DataBaseError;
469	+	if FSQLType = SQL_BLOB then
470	+	begin
471	+	FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
472	+	Check4DataBaseError;
473	+	end
474	+	else
475	+	FSQLSubType := 0;
476	+	FDataLength := aMetaData.getLength(StatusIntf,Index);
477	+	Check4DataBaseError;
478	+	FMetadataSize := FDataLength;
479	+	FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
480	+	Check4DataBaseError;
481	+	FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
482	+	Check4DataBaseError;
483	+	FNullable := aMetaData.isNullable(StatusIntf,Index);
484	+	Check4DataBaseError;
485	+	FScale := aMetaData.getScale(StatusIntf,Index);
486	+	Check4DataBaseError;
487	+	FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
488	+	Check4DataBaseError;
489	+	end;
490	+	end;
491	+
492	+	procedure TIBXSQLVAR.ColumnSQLDataInit;
493	+	begin
494	+	FreeSQLData;
495	+	with FFirebird30ClientAPI do
496	+	begin
497	+	case SQLType of
498	+	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
499	+	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
500	+	SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
501	+	SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
502	+	SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
503	+	begin
504	+	if (FDataLength = 0) then
505	+	{ Make sure you get a valid pointer anyway
506	+	select '' from foo }
507	+	IBAlloc(FSQLData, 0, 1)
508	+	else
509	+	IBAlloc(FSQLData, 0, FDataLength)
510	+	end;
511	+	SQL_VARYING:
512	+	IBAlloc(FSQLData, 0, FDataLength + 2);
513	+	else
514	+	IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)])
515	+	end;
516	+	FOwnsSQLData := true;
517	+	FNullIndicator := -1;
518	+	end;
519	+	end;
520	+
521	+	function TIBXSQLVAR.CanChangeSQLType: boolean;
522	+	begin
523	+	Result := Parent.CanChangeMetaData;
524	+	end;
525	+
526		function TIBXSQLVAR.GetSQLType: cardinal;
527		begin
528		Result := FSQLType;
#	Line 290 | Line 533 | begin
533		Result := FSQLSubType;
534		end;
535
536	<	function TIBXSQLVAR.GetAliasName: string;
536	>	function TIBXSQLVAR.GetAliasName: AnsiString;
537	>	var metadata: Firebird.IMessageMetadata;
538		begin
539	<	with Firebird30ClientAPI do
540	<	begin
541	<	result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
542	<	Check4DataBaseError;
539	>	metadata := TIBXSQLDA(Parent).GetMetaData;
540	>	try
541	>	with FFirebird30ClientAPI do
542	>	begin
543	>	result := strpas(metaData.getAlias(StatusIntf,Index));
544	>	Check4DataBaseError;
545	>	end;
546	>	finally
547	>	metadata.release;
548		end;
549		end;
550
551	<	function TIBXSQLVAR.GetFieldName: string;
551	>	function TIBXSQLVAR.GetFieldName: AnsiString;
552		begin
553		Result := FFieldName;
554		end;
555
556	<	function TIBXSQLVAR.GetOwnerName: string;
556	>	function TIBXSQLVAR.GetOwnerName: AnsiString;
557	>	var metadata: Firebird.IMessageMetadata;
558		begin
559	<	with Firebird30ClientAPI do
560	<	begin
561	<	result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
562	<	Check4DataBaseError;
559	>	metadata := TIBXSQLDA(Parent).GetMetaData;
560	>	try
561	>	with FFirebird30ClientAPI do
562	>	begin
563	>	result := strpas(metaData.getOwner(StatusIntf,Index));
564	>	Check4DataBaseError;
565	>	end;
566	>	finally
567	>	metadata.release;
568		end;
569		end;
570
571	<	function TIBXSQLVAR.GetRelationName: string;
571	>	function TIBXSQLVAR.GetRelationName: AnsiString;
572		begin
573		Result := FRelationName;
574		end;
#	Line 325 | Line 580 | end;
580
581		function TIBXSQLVAR.GetCharSetID: cardinal;
582		begin
583	<	result := 0;
583	>	result := 0; {NONE}
584		case SQLType of
585		SQL_VARYING, SQL_TEXT:
586		result := FCharSetID;
587
588		SQL_BLOB:
589		if (SQLSubType = 1) then
590	<	result := FCharSetID;
590	>	result := FCharSetID
591	>	else
592	>	result := 1; {OCTETS}
593
594		SQL_ARRAY:
595		if (FRelationName <> '') and (FFieldName <> '') then
#	Line 342 | Line 599 | begin
599		end;
600		end;
601
345	–	function TIBXSQLVAR.GetCodePage: TSystemCodePage;
346	–	begin
347	–	result := CP_NONE;
348	–	with Firebird30ClientAPI do
349	–	CharSetID2CodePage(GetCharSetID,result);
350	–	end;
351	–
602		function TIBXSQLVAR.GetIsNull: Boolean;
603		begin
604		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 359 | Line 609 | begin
609		Result := FSQLNullIndicator <> nil;
610		end;
611
612	<	function TIBXSQLVAR.GetSQLData: PChar;
612	>	function TIBXSQLVAR.GetSQLData: PByte;
613		begin
614		Result := FSQLData;
615		end;
#	Line 369 | Line 619 | begin
619		Result := FDataLength;
620		end;
621
622	+	function TIBXSQLVAR.GetSize: cardinal;
623	+	begin
624	+	Result := FMetadataSize;
625	+	end;
626	+
627		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
628		begin
629		if GetSQLType <> SQL_ARRAY then
630		IBError(ibxeInvalidDataConversion,[nil]);
631
632		if FArrayMetaData = nil then
633	<	FArrayMetaData := TFB30ArrayMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
634	<	FStatement.GetTransaction as TFB30Transaction,
633	>	FArrayMetaData := TFB30ArrayMetaData.Create(GetAttachment as TFB30Attachment,
634	>	GetTransaction as TFB30Transaction,
635		GetRelationName,GetFieldName);
636		Result := FArrayMetaData;
637		end;
#	Line 387 | Line 642 | begin
642		IBError(ibxeInvalidDataConversion,[nil]);
643
644		if FBlobMetaData = nil then
645	<	FBlobMetaData := TFB30BlobMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
646	<	FStatement.GetTransaction as TFB30Transaction,
645	>	FBlobMetaData := TFB30BlobMetaData.Create(GetAttachment as TFB30Attachment,
646	>	GetTransaction as TFB30Transaction,
647		GetRelationName,GetFieldName,
648		GetSubType);
649		(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
#	Line 418 | Line 673 | begin
673		end
674		else
675		FSQLNullIndicator := nil;
676	+	Changed;
677		end;
678
679	<	procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
679	>	procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
680		begin
681		if FOwnsSQLData then
682		FreeMem(FSQLData);
683		FSQLData := AValue;
684		FDataLength := len;
685		FOwnsSQLData := false;
686	+	Changed;
687		end;
688
689	<	procedure TIBXSQLVAR.SetScale(aValue: integer);
689	>	procedure TIBXSQLVAR.InternalSetScale(aValue: integer);
690		begin
691		FScale := aValue;
692	+	Changed;
693		end;
694
695	<	procedure TIBXSQLVAR.SetDataLength(len: cardinal);
695	>	procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal);
696		begin
697		if not FOwnsSQLData then
698		FSQLData := nil;
699		FDataLength := len;
700	<	with Firebird30ClientAPI do
700	>	with FFirebird30ClientAPI do
701		IBAlloc(FSQLData, 0, FDataLength);
702		FOwnsSQLData := true;
703	+	Changed;
704		end;
705
706	<	procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706	>	procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707		begin
708		FSQLType := aValue;
709	+	Changed;
710		end;
711
712		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
713		begin
714		FCharSetID := aValue;
715	+	Changed;
716	+	end;
717	+
718	+	procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal);
719	+	begin
720	+	if (aValue > FMetaDataSize) and not CanChangeSQLType then
721	+	IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]);
722	+	FMetaDataSize := aValue;
723	+	end;
724	+
725	+	function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
726	+	begin
727	+	Result := SQL_VARYING;
728		end;
729
730		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
731		begin
732		inherited Create(aParent,aIndex);
733		FStatement := aParent.Statement;
734	+	FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
735		end;
736
737		procedure TIBXSQLVAR.RowChange;
738		begin
739		inherited;
740		FBlob := nil;
467	–	FArray := nil;
741		end;
742
743		procedure TIBXSQLVAR.FreeSQLData;
#	Line 475 | Line 748 | begin
748		FOwnsSQLData := true;
749		end;
750
751	<	function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
751	>	function TIBXSQLVAR.GetAsArray: IArray;
752		begin
753		if SQLType <> SQL_ARRAY then
754		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 484 | Line 757 | begin
757		Result := nil
758		else
759		begin
760	<	if FArray = nil then
761	<	FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
762	<	TIBXSQLDA(Parent).GetTransaction,
763	<	GetArrayMetaData,Array_ID);
764	<	Result := FArray;
760	>	if FArrayIntf = nil then
761	>	FArrayIntf := TFB30Array.Create(GetAttachment as TFB30Attachment,
762	>	GetTransaction as TFB30Transaction,
763	>	GetArrayMetaData,PISC_QUAD(SQLData)^);
764	>	Result := FArrayIntf;
765		end;
766		end;
767
#	Line 503 | Line 776 | begin
776		if IsNull then
777		Result := nil
778		else
779	<	Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
780	<	TIBXSQLDA(Parent).GetTransaction,
779	>	Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
780	>	GetTransaction as TFB30Transaction,
781		GetBlobMetaData,
782		Blob_ID,BPB);
783		FBlob := Result;
#	Line 513 | Line 786 | end;
786
787		function TIBXSQLVAR.CreateBlob: IBlob;
788		begin
789	<	Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
790	<	FStatement.GetTransaction as TFB30Transaction,
789	>	Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
790	>	GetTransaction as TFB30Transaction,
791		GetSubType,GetCharSetID,nil);
792		end;
793
794		{ TResultSet }
795
796	+	procedure TResultSet.RowChange;
797	+	var i: integer;
798	+	begin
799	+	for i := 0 to getCount - 1 do
800	+	FResults.Column[i].RowChange;
801	+	end;
802	+
803		constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
804		begin
805		inherited Create(aResults);
#	Line 534 | Line 814 | begin
814		end;
815
816		function TResultSet.FetchNext: boolean;
537	–	var i: integer;
817		begin
818		CheckActive;
819	<	Result := FResults.FStatement.FetchNext;
819	>	Result := FResults.FStatement.Fetch(ftNext);
820	>	if Result then
821	>	RowChange;
822	>	end;
823	>
824	>	function TResultSet.FetchPrior: boolean;
825	>	begin
826	>	CheckActive;
827	>	Result := FResults.FStatement.Fetch(ftPrior);
828	>	if Result then
829	>	RowChange;
830	>	end;
831	>
832	>	function TResultSet.FetchFirst: boolean;
833	>	begin
834	>	CheckActive;
835	>	Result := FResults.FStatement.Fetch(ftFirst);
836	>	if Result then
837	>	RowChange;
838	>	end;
839	>
840	>	function TResultSet.FetchLast: boolean;
841	>	begin
842	>	CheckActive;
843	>	Result := FResults.FStatement.Fetch(ftLast);
844	>	if Result then
845	>	RowChange;
846	>	end;
847	>
848	>	function TResultSet.FetchAbsolute(position: Integer): boolean;
849	>	begin
850	>	CheckActive;
851	>	Result := FResults.FStatement.Fetch(ftAbsolute,position);
852		if Result then
853	<	for i := 0 to getCount - 1 do
543	<	FResults.Column[i].RowChange;
853	>	RowChange;
854		end;
855
856	<	function TResultSet.GetCursorName: string;
856	>	function TResultSet.FetchRelative(offset: Integer): boolean;
857		begin
858	<	IBError(ibxeNotSupported,[nil]);
859	<	Result := '';
858	>	CheckActive;
859	>	Result := FResults.FStatement.Fetch(ftRelative,offset);
860	>	if Result then
861	>	RowChange;
862		end;
863
864	<	function TResultSet.GetTransaction: ITransaction;
864	>	function TResultSet.GetCursorName: AnsiString;
865		begin
866	<	Result := FResults.FTransaction;
866	>	Result := FResults.FStatement.FCursor;
867	>	end;
868	>
869	>	function TResultSet.IsBof: boolean;
870	>	begin
871	>	Result := FResults.FStatement.FBof;
872		end;
873
874		function TResultSet.IsEof: boolean;
#	Line 580 | Line 897 | begin
897		end;
898		end;
899
900	<	procedure TIBXINPUTSQLDA.FreeMessageBuffer;
900	>	procedure TIBXINPUTSQLDA.FreeCurMetaData;
901		begin
902		if FCurMetaData <> nil then
903		begin
904		FCurMetaData.release;
905		FCurMetaData := nil;
906		end;
590	–	if FMessageBuffer <> nil then
591	–	begin
592	–	FreeMem(FMessageBuffer);
593	–	FMessageBuffer := nil;
594	–	end;
595	–	FMsgLength := 0;
907		end;
908
909	<	function TIBXINPUTSQLDA.GetMessageBuffer: PChar;
909	>	function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
910		begin
911		PackBuffer;
912		Result := FMessageBuffer;
#	Line 603 | Line 914 | end;
914
915		function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
916		begin
917	<	PackBuffer;
917	>	BuildMetadata;
918		Result := FCurMetaData;
919	+	if Result <> nil then
920	+	Result.addRef;
921		end;
922
923		function TIBXINPUTSQLDA.GetMsgLength: integer;
#	Line 613 | Line 926 | begin
926		Result := FMsgLength;
927		end;
928
929	<	procedure TIBXINPUTSQLDA.PackBuffer;
929	>	procedure TIBXINPUTSQLDA.BuildMetadata;
930		var Builder: Firebird.IMetadataBuilder;
931		i: integer;
932	+	version: NativeInt;
933		begin
934	<	if FMsgLength > 0 then Exit;
935	<
622	<	with Firebird30ClientAPI do
934	>	if (FCurMetaData = nil) and (Count > 0) then
935	>	with FFirebird30ClientAPI do
936		begin
937	<	Builder := inherited MetaData.getBuilder(StatusIntf);
937	>	Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count);
938		Check4DataBaseError;
939		try
940		for i := 0 to Count - 1 do
941		with TIBXSQLVar(Column[i]) do
942		begin
943	+	version := Builder.vtable.version;
944	+	if version >= 4 then
945	+	{Firebird 4 or later}
946	+	begin
947	+	Builder.setField(StatusIntf,i,PAnsiChar(Name));
948	+	Check4DataBaseError;
949	+	Builder.setAlias(StatusIntf,i,PAnsiChar(Name));
950	+	Check4DataBaseError;
951	+	end;
952		Builder.setType(StatusIntf,i,FSQLType);
953		Check4DataBaseError;
954		Builder.setSubType(StatusIntf,i,FSQLSubType);
955		Check4DataBaseError;
956	<	Builder.setLength(StatusIntf,i,FDataLength);
956	>	//        writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
957	>	if FSQLType = SQL_VARYING then
958	>	begin
959	>	{The datalength can be greater than the metadata size when SQLType has been overridden to text}
960	>	if (GetDataLength > GetSize) and CanChangeMetaData then
961	>	Builder.setLength(StatusIntf,i,GetDataLength)
962	>	else
963	>	Builder.setLength(StatusIntf,i,GetSize)
964	>	end
965	>	else
966	>	Builder.setLength(StatusIntf,i,GetDataLength);
967		Check4DataBaseError;
968		Builder.setCharSet(StatusIntf,i,GetCharSetID);
969		Check4DataBaseError;
#	Line 643 | Line 975 | begin
975		finally
976		Builder.release;
977		end;
978	+	end;
979	+	end;
980
981	<	FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
981	>	procedure TIBXINPUTSQLDA.PackBuffer;
982	>	var i: integer;
983	>	P: PByte;
984	>	MsgLen: cardinal;
985	>	aNullIndicator: short;
986	>	begin
987	>	BuildMetadata;
988	>
989	>	if (FMsgLength = 0) and (FCurMetaData <> nil) then
990	>	with FFirebird30ClientAPI do
991	>	begin
992	>	MsgLen := FCurMetaData.getMessageLength(StatusIntf);
993		Check4DataBaseError;
994
995	<	IBAlloc(FMessageBuffer,0,FMsgLength);
995	>	AllocMessageBuffer(MsgLen);
996
997		for i := 0 to Count - 1 do
998		with TIBXSQLVar(Column[i]) do
999		begin
1000	+	P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
1001	+	//     writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
1002	+	if not Modified then
1003	+	IBError(ibxeUninitializedInputParameter,[i,Name]);
1004		if IsNull then
1005	<	FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1005	>	FillChar(P^,FDataLength,0)
1006		else
1007	<	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1008	<	Check4DataBaseError;
1007	>	if FSQLData <> nil then
1008	>	begin
1009	>	if SQLType = SQL_VARYING then
1010	>	begin
1011	>	EncodeInteger(FDataLength,2,P);
1012	>	Inc(P,2);
1013	>	end
1014	>	else
1015	>	if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
1016	>	begin
1017	>	FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
1018	>	Check4DatabaseError;
1019	>	end;
1020	>	Move(FSQLData^,P^,FDataLength);
1021	>	end;
1022		if IsNullable then
1023		begin
1024		Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
1025		Check4DataBaseError;
1026	+	end
1027	+	else
1028	+	begin
1029	+	aNullIndicator := 0;
1030	+	Move(aNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(aNullIndicator));
1031		end;
1032		end;
1033		end;
#	Line 669 | Line 1036 | end;
1036		procedure TIBXINPUTSQLDA.FreeXSQLDA;
1037		begin
1038		inherited FreeXSQLDA;
1039	<	FreeMessageBuffer;
1039	>	FreeCurMetaData;
1040		end;
1041
1042		constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
#	Line 678 | Line 1045 | begin
1045		FMessageBuffer := nil;
1046		end;
1047
1048	+	constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI);
1049	+	begin
1050	+	inherited Create(api);
1051	+	FMessageBuffer := nil;
1052	+	end;
1053	+
1054		destructor TIBXINPUTSQLDA.Destroy;
1055		begin
1056	<	FreeMessageBuffer;
1056	>	FreeXSQLDA;
1057		inherited Destroy;
1058		end;
1059
#	Line 688 | Line 1061 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1061		var i: integer;
1062		begin
1063		FMetaData := aMetaData;
1064	<	with Firebird30ClientAPI do
1064	>	FMetaData.AddRef;
1065	>	with FFirebird30ClientAPI do
1066		begin
1067	<	Count := metadata.getCount(StatusIntf);
1067	>	Count := aMetadata.getCount(StatusIntf);
1068		Check4DataBaseError;
1069		Initialize;
1070
1071		for i := 0 to Count - 1 do
1072		with TIBXSQLVar(Column[i]) do
1073		begin
1074	<	FSQLType := aMetaData.getType(StatusIntf,i);
1075	<	Check4DataBaseError;
702	<	if FSQLType = SQL_BLOB then
703	<	begin
704	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
705	<	Check4DataBaseError;
706	<	end
707	<	else
708	<	FSQLSubType := 0;
709	<	FDataLength := aMetaData.getLength(StatusIntf,i);
710	<	Check4DataBaseError;
711	<	case SQLType of
712	<	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
713	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
714	<	SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
715	<	begin
716	<	if (FDataLength = 0) then
717	<	{ Make sure you get a valid pointer anyway
718	<	select '' from foo }
719	<	IBAlloc(FSQLData, 0, 1)
720	<	else
721	<	IBAlloc(FSQLData, 0, FDataLength)
722	<	end;
723	<	SQL_VARYING:
724	<	IBAlloc(FSQLData, 0, FDataLength + 2);
725	<	else
726	<	IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
727	<	end;
728	<	FNullable := aMetaData.isNullable(StatusIntf,i);
729	<	FOwnsSQLData := true;
730	<	Check4DataBaseError;
731	<	FNullIndicator := -1;
1074	>	InitColumnMetaData(aMetaData);
1075	>	SaveMetaData;
1076		if FNullable then
1077		FSQLNullIndicator := @FNullIndicator
1078		else
1079		FSQLNullIndicator := nil;
1080	<	FScale := aMetaData.getScale(StatusIntf,i);
737	<	Check4DataBaseError;
738	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
739	<	Check4DataBaseError;
1080	>	ColumnSQLDataInit;
1081		end;
1082		end;
1083		end;
#	Line 744 | Line 1085 | end;
1085		procedure TIBXINPUTSQLDA.Changed;
1086		begin
1087		inherited Changed;
1088	+	FreeCurMetaData;
1089	+	FreeMessageBuffer;
1090	+	end;
1091	+
1092	+	procedure TIBXINPUTSQLDA.ReInitialise;
1093	+	var i: integer;
1094	+	begin
1095		FreeMessageBuffer;
1096	+	for i := 0 to Count - 1 do
1097	+	TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1098		end;
1099
1100		function TIBXINPUTSQLDA.IsInputDataArea: boolean;
#	Line 754 | Line 1104 | end;
1104
1105		{ TIBXOUTPUTSQLDA }
1106
1107	<	procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
1107	>	function TIBXOUTPUTSQLDA.GetTransaction: ITransaction;
1108		begin
1109	<	inherited FreeXSQLDA;
1110	<	FreeMem(FMessageBuffer);
1111	<	FMessageBuffer := nil;
1112	<	FMsgLength := 0;
1109	>	if FTransaction <> nil then
1110	>	Result := FTransaction
1111	>	else
1112	>	Result := inherited GetTransaction;
1113		end;
1114
1115		procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
1116		var i: integer;
1117	+	MsgLen: cardinal;
1118		begin
1119		FMetaData := aMetaData;
1120	<	with Firebird30ClientAPI do
1120	>	FMetaData.AddRef;
1121	>	with FFirebird30ClientAPI do
1122		begin
1123	<	Count := metadata.getCount(StatusIntf);
1123	>	Count := aMetaData.getCount(StatusIntf);
1124		Check4DataBaseError;
1125		Initialize;
1126
1127	<	FMsgLength := metaData.getMessageLength(StatusIntf);
1127	>	MsgLen := aMetaData.getMessageLength(StatusIntf);
1128		Check4DataBaseError;
1129	<	IBAlloc(FMessageBuffer,0,FMsgLength);
1129	>	AllocMessageBuffer(MsgLen);
1130
1131		for i := 0 to Count - 1 do
1132		with TIBXSQLVar(Column[i]) do
1133		begin
1134	<	FSQLType := aMetaData.getType(StatusIntf,i);
1135	<	Check4DataBaseError;
784	<	if FSQLType = SQL_BLOB then
785	<	begin
786	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
787	<	Check4DataBaseError;
788	<	end
789	<	else
790	<	FSQLSubType := 0;
791	<	FBlob := nil;
792	<	FArray := nil;
793	<	FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
794	<	Check4DataBaseError;
795	<	FDataLength := aMetaData.getLength(StatusIntf,i);
796	<	Check4DataBaseError;
797	<	FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
798	<	Check4DataBaseError;
799	<	FFieldName := strpas(aMetaData.getField(StatusIntf,i));
800	<	Check4DataBaseError;
801	<	FNullable := aMetaData.isNullable(StatusIntf,i);
1134	>	InitColumnMetaData(aMetaData);
1135	>	FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1136		Check4DataBaseError;
1137		if FNullable then
1138		begin
#	Line 807 | Line 1141 | begin
1141		end
1142		else
1143		FSQLNullIndicator := nil;
1144	<	FScale := aMetaData.getScale(StatusIntf,i);
1145	<	Check4DataBaseError;
812	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
813	<	Check4DataBaseError;
1144	>	FBlob := nil;
1145	>	FArrayIntf := nil;
1146		end;
1147		end;
1148		SetUniqueRelationName;
1149		end;
1150
1151		procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean;
1152	<	var len: short; var data: PChar);
1152	>	var len: short; var data: PByte);
1153		begin
1154		with TIBXSQLVAR(Column[index]) do
1155		begin
#	Line 826 | Line 1158 | begin
1158		len := FDataLength;
1159		if not IsNull and (FSQLType = SQL_VARYING) then
1160		begin
1161	<	with Firebird30ClientAPI do
1161	>	with FFirebird30ClientAPI do
1162		len := DecodeInteger(data,2);
1163		Inc(Data,2);
1164		end;
#	Line 843 | Line 1175 | constructor TIBXSQLDA.Create(aStatement:
1175		begin
1176		inherited Create;
1177		FStatement := aStatement;
1178	+	FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
1179		FSize := 0;
1180		//  writeln('Creating ',ClassName);
1181		end;
1182
1183	+	constructor TIBXSQLDA.Create(api: IFirebirdAPI);
1184	+	begin
1185	+	inherited Create;
1186	+	FStatement := nil;
1187	+	FSize := 0;
1188	+	FFirebird30ClientAPI := api as TFB30ClientAPI;
1189	+	end;
1190	+
1191		destructor TIBXSQLDA.Destroy;
1192		begin
1193		FreeXSQLDA;
#	Line 862 | Line 1203 | end;
1203		function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
1204		begin
1205		Result := false;
1206	+	if FStatement <> nil then
1207		case Request of
1208		ssPrepared:
1209		Result := FStatement.IsPrepared;
1210
1211		ssExecuteResults:
1212	<	Result :=FStatement.FSingleResults;
1212	>	Result := FStatement.FSingleResults;
1213
1214		ssCursorOpen:
1215		Result := FStatement.FOpen;
#	Line 885 | Line 1227 | begin
1227		Result := FCount;
1228		end;
1229
888	–	function TIBXSQLDA.GetTransaction: TFB30Transaction;
889	–	begin
890	–	Result := FStatement.GetTransaction as TFB30Transaction;
891	–	end;
892	–
1230		procedure TIBXSQLDA.Initialize;
1231		begin
1232		if FMetaData <> nil then
#	Line 898 | Line 1235 | end;
1235
1236		function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
1237		begin
1238	<	Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
1238	>	Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo);
1239		if Result then
1240		ChangeSeqNo := FStatement.ChangeSeqNo;
1241		end;
1242
1243	+	function TIBXSQLDA.CanChangeMetaData: boolean;
1244	+	begin
1245	+	Result := FStatement.FBatch = nil;
1246	+	end;
1247	+
1248		procedure TIBXSQLDA.SetCount(Value: Integer);
1249		var
1250		i: Integer;
#	Line 919 | Line 1261 | begin
1261		end;
1262		end;
1263
1264	+	procedure TIBXSQLDA.AllocMessageBuffer(len: integer);
1265	+	begin
1266	+	with FFirebird30ClientAPI do
1267	+	IBAlloc(FMessageBuffer,0,len);
1268	+	FMsgLength := len;
1269	+	end;
1270	+
1271	+	procedure TIBXSQLDA.FreeMessageBuffer;
1272	+	begin
1273	+	if FMessageBuffer <> nil then
1274	+	begin
1275	+	FreeMem(FMessageBuffer);
1276	+	FMessageBuffer := nil;
1277	+	end;
1278	+	FMsgLength := 0;
1279	+	end;
1280	+
1281	+	function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata;
1282	+	begin
1283	+	Result := FMetadata;
1284	+	if Result <> nil then
1285	+	Result.addRef;
1286	+	end;
1287	+
1288		function TIBXSQLDA.GetTransactionSeqNo: integer;
1289		begin
1290		Result := FTransactionSeqNo;
#	Line 934 | Line 1300 | begin
1300		TIBXSQLVAR(Column[i]).FreeSQLData;
1301		for i := 0 to FSize - 1  do
1302		TIBXSQLVAR(Column[i]).Free;
1303	+	FCount := 0;
1304		SetLength(FColumnList,0);
1305		FSize := 0;
1306	+	FreeMessageBuffer;
1307		end;
1308
1309		function TIBXSQLDA.GetStatement: IStatement;
#	Line 945 | Line 1313 | end;
1313
1314		function TIBXSQLDA.GetPrepareSeqNo: integer;
1315		begin
1316	<	Result := FStatement.FPrepareSeqNo;
1316	>	if FStatement = nil then
1317	>	Result := 0
1318	>	else
1319	>	Result := FStatement.FPrepareSeqNo;
1320		end;
1321
1322		{ TFB30Statement }
1323
1324	+	procedure TFB30Statement.CheckChangeBatchRowLimit;
1325	+	begin
1326	+	if IsInBatchMode then
1327	+	IBError(ibxeInBatchMode,[nil]);
1328	+	end;
1329	+
1330		procedure TFB30Statement.CheckHandle;
1331		begin
1332		if FStatementIntf = nil then
1333		IBError(ibxeInvalidStatementHandle,[nil]);
1334		end;
1335
1336	+	procedure TFB30Statement.CheckBatchModeAvailable;
1337	+	begin
1338	+	if not HasBatchMode then
1339	+	IBError(ibxeBatchModeNotSupported,[nil]);
1340	+	case SQLStatementType of
1341	+	SQLInsert,
1342	+	SQLUpdate: {OK};
1343	+	else
1344	+	IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1345	+	end;
1346	+	end;
1347	+
1348		procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1349		);
1350		begin
1351	<	with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1351	>	with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1352		begin
1353		StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1354		GetBufSize, BytePtr(Buffer));
#	Line 967 | Line 1356 | begin
1356		end;
1357		end;
1358
1359	<	procedure TFB30Statement.InternalPrepare;
1359	>	function TFB30Statement.GetStatementIntf: IStatement;
1360	>	begin
1361	>	Result := self;
1362	>	end;
1363	>
1364	>	procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1365	>	var GUID : TGUID;
1366	>	metadata: Firebird.IMessageMetadata;
1367		begin
1368		if FPrepared then
1369		Exit;
1370	+
1371	+	FCursor := CursorName;
1372		if (FSQL = '') then
1373		IBError(ibxeEmptyQuery, [nil]);
1374		try
1375		CheckTransaction(FTransactionIntf);
1376	<	with Firebird30ClientAPI do
1376	>	with FFirebird30ClientAPI do
1377		begin
1378	+	if FCursor = '' then
1379	+	begin
1380	+	CreateGuid(GUID);
1381	+	FCursor := GUIDToString(GUID);
1382	+	end;
1383	+
1384		if FHasParamNames then
1385		begin
1386		if FProcessedSQL = '' then
1387	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1387	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1388		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1389		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1390		Length(FProcessedSQL),
1391	<	PChar(FProcessedSQL),
1391	>	PAnsiChar(FProcessedSQL),
1392		FSQLDialect,
1393		Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1394		end
#	Line 992 | Line 1396 | begin
1396		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1397		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1398		Length(FSQL),
1399	<	PChar(FSQL),
1399	>	PAnsiChar(FSQL),
1400		FSQLDialect,
1401		Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1402		Check4DataBaseError;
1403		FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1404		Check4DataBaseError;
1405
1406	+	if FSQLStatementType = SQLSelect then
1407	+	begin
1408	+	FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1409	+	Check4DataBaseError;
1410	+	end;
1411		{ Done getting the type }
1412		case FSQLStatementType of
1413		SQLGetSegment,
#	Line 1015 | Line 1424 | begin
1424		SQLExecProcedure:
1425		begin
1426		{set up input sqlda}
1427	<	FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1427	>	metadata := FStatementIntf.getInputMetadata(StatusIntf);
1428		Check4DataBaseError;
1429	+	try
1430	+	FSQLParams.Bind(metadata);
1431	+	finally
1432	+	metadata.release;
1433	+	end;
1434
1435		{setup output sqlda}
1436		if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1437		SQLExecProcedure] then
1438	<	FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1439	<	Check4DataBaseError;
1438	>	begin
1439	>	metadata := FStatementIntf.getOutputMetadata(StatusIntf);
1440	>	Check4DataBaseError;
1441	>	try
1442	>	FSQLRecord.Bind(metadata);
1443	>	finally
1444	>	metadata.release;
1445	>	end;
1446	>	end;
1447		end;
1448		end;
1449		end;
#	Line 1031 | Line 1452 | begin
1452		if (FStatementIntf <> nil) then
1453		FreeHandle;
1454		if E is EIBInterBaseError then
1455	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1456	<	EIBInterBaseError(E).IBErrorCode,
1036	<	EIBInterBaseError(E).Message +
1037	<	sSQLErrorSeparator + FSQL)
1038	<	else
1039	<	raise;
1455	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1456	>	raise;
1457		end;
1458		end;
1459		FPrepared := true;
1460	+
1461		FSingleResults := false;
1462		if RetainInterfaces then
1463		begin
#	Line 1057 | Line 1475 | begin
1475		end;
1476
1477		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1478	+
1479	+	procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1480	+	var inMetadata: Firebird.IMessageMetaData;
1481	+	begin
1482	+	with FFirebird30ClientAPI do
1483	+	begin
1484	+	SavePerfStats(FBeforeStats);
1485	+	inMetadata := FSQLParams.GetMetaData;
1486	+	try
1487	+	FStatementIntf.execute(StatusIntf,
1488	+	(aTransaction as TFB30Transaction).TransactionIntf,
1489	+	inMetaData,
1490	+	FSQLParams.MessageBuffer,
1491	+	outMetaData,
1492	+	outBuffer);
1493	+	Check4DataBaseError;
1494	+	finally
1495	+	if inMetadata <> nil then
1496	+	inMetadata.release;
1497	+	end;
1498	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1499	+	end;
1500	+	end;
1501	+
1502	+	var Cursor: IResultSet;
1503	+	outMetadata: Firebird.IMessageMetaData;
1504	+
1505		begin
1506		Result := nil;
1507	+	FBatchCompletion := nil;
1508		FBOF := false;
1509		FEOF := false;
1510		FSingleResults := false;
1511	+	FStatisticsAvailable := false;
1512	+	if IsInBatchMode then
1513	+	IBerror(ibxeInBatchMode,[]);
1514		CheckTransaction(aTransaction);
1515		if not FPrepared then
1516		InternalPrepare;
1517		CheckHandle;
1518		if aTransaction <> FTransactionIntf then
1519		AddMonitor(aTransaction as TFB30Transaction);
1520	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1520	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1521		IBError(ibxeInterfaceOutofDate,[nil]);
1522
1523	+
1524		try
1525	<	with Firebird30ClientAPI do
1525	>	with FFirebird30ClientAPI do
1526		begin
1077	–	if FCollectStatistics then
1078	–	begin
1079	–	UtilIntf.getPerfCounters(StatusIntf,
1080	–	(GetAttachment as TFB30Attachment).AttachmentIntf,
1081	–	ISQL_COUNTERS,@FBeforeStats);
1082	–	Check4DataBaseError;
1083	–	end;
1084	–
1527		case FSQLStatementType of
1528		SQLSelect:
1529	<	IBError(ibxeIsAExecuteProcedure,[]);
1529	>	{e.g. Update...returning with a single row in Firebird 5 and later}
1530	>	begin
1531	>	Cursor := InternalOpenCursor(aTransaction,false);
1532	>	if not Cursor.IsEof then
1533	>	Cursor.FetchNext;
1534	>	Result := Cursor; {note only first row}
1535	>	FSingleResults := true;
1536	>	end;
1537
1538		SQLExecProcedure:
1539		begin
1540	<	FStatementIntf.execute(StatusIntf,
1541	<	(aTransaction as TFB30Transaction).TransactionIntf,
1542	<	FSQLParams.MetaData,
1543	<	FSQLParams.MessageBuffer,
1544	<	FSQLRecord.MetaData,
1545	<	FSQLRecord.MessageBuffer);
1546	<	Check4DataBaseError;
1540	>	outMetadata := FSQLRecord.GetMetaData;
1541	>	try
1542	>	ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer);
1543	>	Result := TResults.Create(FSQLRecord);
1544	>	FSingleResults := true;
1545	>	finally
1546	>	if outMetadata <> nil then
1547	>	outMetadata.release;
1548	>	end;
1549	>	end;
1550
1099	–	Result := TResults.Create(FSQLRecord);
1100	–	FSingleResults := true;
1101	–	end
1551		else
1552	<	FStatementIntf.execute(StatusIntf,
1104	<	(aTransaction as TFB30Transaction).TransactionIntf,
1105	<	FSQLParams.MetaData,
1106	<	FSQLParams.MessageBuffer,
1107	<	nil,
1108	<	nil);
1109	<	Check4DataBaseError;
1110	<	end;
1111	<	if FCollectStatistics then
1112	<	begin
1113	<	UtilIntf.getPerfCounters(StatusIntf,
1114	<	(GetAttachment as TFB30Attachment).AttachmentIntf,
1115	<	ISQL_COUNTERS, @FAfterStats);
1116	<	Check4DataBaseError;
1117	<	FStatisticsAvailable := true;
1552	>	ExecuteQuery;
1553		end;
1554		end;
1555		finally
#	Line 1122 | Line 1557 | begin
1557		RemoveMonitor(aTransaction as TFB30Transaction);
1558		end;
1559		FExecTransactionIntf := aTransaction;
1560	+	FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1561	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1562		SignalActivity;
1563		Inc(FChangeSeqNo);
1564		end;
1565
1566	<	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1567	<	): IResultSet;
1566	>	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1567	>	Scrollable: boolean): IResultSet;
1568	>	var flags: cardinal;
1569	>	inMetadata,
1570	>	outMetadata: Firebird.IMessageMetadata;
1571		begin
1572	<	if FSQLStatementType <> SQLSelect then
1572	>	flags := 0;
1573	>	if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1574		IBError(ibxeIsASelectStatement,[]);
1575
1576	<	CheckTransaction(aTransaction);
1576	>	FBatchCompletion := nil;
1577	>	CheckTransaction(aTransaction);
1578		if not FPrepared then
1579		InternalPrepare;
1580		CheckHandle;
1581		if aTransaction <> FTransactionIntf then
1582		AddMonitor(aTransaction as TFB30Transaction);
1583	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1583	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1584		IBError(ibxeInterfaceOutofDate,[nil]);
1585
1586	<	with Firebird30ClientAPI do
1586	>	if Scrollable then
1587	>	flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1588	>
1589	>	with FFirebird30ClientAPI do
1590		begin
1591		if FCollectStatistics then
1592		begin
#	Line 1151 | Line 1596 | begin
1596		Check4DataBaseError;
1597		end;
1598
1599	<	FResultSet := FStatementIntf.openCursor(StatusIntf,
1599	>	inMetadata := FSQLParams.GetMetaData;
1600	>	outMetadata := FSQLRecord.GetMetaData;
1601	>	try
1602	>	FResultSet := FStatementIntf.openCursor(StatusIntf,
1603		(aTransaction as TFB30Transaction).TransactionIntf,
1604	<	FSQLParams.MetaData,
1604	>	inMetaData,
1605		FSQLParams.MessageBuffer,
1606	<	FSQLRecord.MetaData,
1607	<	0);
1608	<	Check4DataBaseError;
1606	>	outMetaData,
1607	>	flags);
1608	>	Check4DataBaseError;
1609	>	finally
1610	>	if inMetadata <> nil then
1611	>	inMetadata.release;
1612	>	if outMetadata <> nil then
1613	>	outMetadata.release;
1614	>	end;
1615
1616		if FCollectStatistics then
1617		begin
#	Line 1181 | Line 1635 | begin
1635		Inc(FChangeSeqNo);
1636		end;
1637
1638	+	procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1639	+	var processedSQL: AnsiString);
1640	+	begin
1641	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1642	+	end;
1643	+
1644		procedure TFB30Statement.FreeHandle;
1645		begin
1646		Close;
1647		ReleaseInterfaces;
1648	+	if FBatch <> nil then
1649	+	begin
1650	+	FBatch.release;
1651	+	FBatch := nil;
1652	+	end;
1653		if FStatementIntf <> nil then
1654		begin
1655		FStatementIntf.release;
1656		FStatementIntf := nil;
1657		FPrepared := false;
1658		end;
1659	+	FCursor := '';
1660		end;
1661
1662		procedure TFB30Statement.InternalClose(Force: boolean);
1663		begin
1664		if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1665		try
1666	<	with Firebird30ClientAPI do
1666	>	with FFirebird30ClientAPI do
1667		begin
1668		if FResultSet <> nil then
1669		begin
#	Line 1211 | Line 1677 | begin
1677		if not Force then Check4DataBaseError;
1678		end;
1679		finally
1680	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1680	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then
1681		RemoveMonitor(FSQLRecord.FTransaction);
1682		FOpen := False;
1683		FExecTransactionIntf := nil;
#	Line 1221 | Line 1687 | begin
1687		Inc(FChangeSeqNo);
1688		end;
1689
1690	+	function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1691	+	begin
1692	+	Result := false;
1693	+	if FCollectStatistics then
1694	+	with FFirebird30ClientAPI do
1695	+	begin
1696	+	UtilIntf.getPerfCounters(StatusIntf,
1697	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1698	+	ISQL_COUNTERS, @Stats);
1699	+	Check4DataBaseError;
1700	+	Result := true;
1701	+	end;
1702	+	end;
1703	+
1704		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1705	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1705	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1706	>	CursorName: AnsiString);
1707		begin
1708		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1709	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1710		FSQLParams := TIBXINPUTSQLDA.Create(self);
1711		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1712	<	InternalPrepare;
1712	>	InternalPrepare(CursorName);
1713		end;
1714
1715		constructor TFB30Statement.CreateWithParameterNames(
1716	<	Attachment: TFB30Attachment; Transaction: ITransaction; sql: string;
1717	<	aSQLDialect: integer; GenerateParamNames: boolean);
1716	>	Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1717	>	aSQLDialect: integer; GenerateParamNames: boolean;
1718	>	CaseSensitiveParams: boolean; CursorName: AnsiString);
1719		begin
1720		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1721	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1722		FSQLParams := TIBXINPUTSQLDA.Create(self);
1723	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1724		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1725	<	InternalPrepare;
1725	>	InternalPrepare(CursorName);
1726		end;
1727
1728		destructor TFB30Statement.Destroy;
#	Line 1247 | Line 1732 | begin
1732		if assigned(FSQLRecord) then FSQLRecord.Free;
1733		end;
1734
1735	<	function TFB30Statement.FetchNext: boolean;
1735	>	function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1736	>	): boolean;
1737		var fetchResult: integer;
1738		begin
1739	<	result := false;
1739	>	result := false;
1740		if not FOpen then
1741		IBError(ibxeSQLClosed, [nil]);
1256	–	if FEOF then
1257	–	IBError(ibxeEOF,[nil]);
1742
1743	<	with Firebird30ClientAPI do
1743	>	with FFirebird30ClientAPI do
1744		begin
1745	<	{ Go to the next record... }
1746	<	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1747	<	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1748	<	begin
1749	<	FBOF := false;
1750	<	FEOF := true;
1751	<	Exit; {End of File}
1752	<	end
1753	<	else
1754	<	if fetchResult <> Firebird.IStatus.RESULT_OK then
1755	<	begin
1756	<	try
1757	<	IBDataBaseError;
1758	<	except
1275	<	Close;
1276	<	raise;
1745	>	case FetchType of
1746	>	ftNext:
1747	>	begin
1748	>	if FEOF then
1749	>	IBError(ibxeEOF,[nil]);
1750	>	{ Go to the next record... }
1751	>	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1752	>	Check4DataBaseError;
1753	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1754	>	begin
1755	>	FBOF := false;
1756	>	FEOF := true;
1757	>	Exit; {End of File}
1758	>	end
1759		end;
1760	<	end
1761	<	else
1760	>
1761	>	ftPrior:
1762	>	begin
1763	>	if FBOF then
1764	>	IBError(ibxeBOF,[nil]);
1765	>	{ Go to the next record... }
1766	>	fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1767	>	Check4DataBaseError;
1768	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1769	>	begin
1770	>	FBOF := true;
1771	>	FEOF := false;
1772	>	Exit; {Top of File}
1773	>	end
1774	>	end;
1775	>
1776	>	ftFirst:
1777	>	begin
1778	>	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1779	>	Check4DataBaseError;
1780	>	end;
1781	>
1782	>	ftLast:
1783	>	begin
1784	>	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1785	>	Check4DataBaseError;
1786	>	end;
1787	>
1788	>	ftAbsolute:
1789	>	begin
1790	>	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1791	>	Check4DataBaseError;
1792	>	end;
1793	>
1794	>	ftRelative:
1795	>	begin
1796	>	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1797	>	Check4DataBaseError;
1798	>	end;
1799	>	end;
1800	>
1801	>	if fetchResult <> Firebird.IStatus.RESULT_OK then
1802	>	exit; {result = false}
1803	>
1804	>	{Result OK}
1805	>	FBOF := false;
1806	>	FEOF := false;
1807	>	result := true;
1808	>
1809	>	if FCollectStatistics then
1810		begin
1811	<	FBOF := false;
1812	<	result := true;
1811	>	UtilIntf.getPerfCounters(StatusIntf,
1812	>	(GetAttachment as TFB30Attachment).AttachmentIntf,
1813	>	ISQL_COUNTERS,@FAfterStats);
1814	>	Check4DataBaseError;
1815	>	FStatisticsAvailable := true;
1816		end;
1817		end;
1818		FSQLRecord.RowChange;
#	Line 1304 | Line 1837 | begin
1837		Result := TMetaData(GetInterface(1));
1838		end;
1839
1840	<	function TFB30Statement.GetPlan: String;
1840	>	function TFB30Statement.GetPlan: AnsiString;
1841		begin
1842		CheckHandle;
1843		if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
#	Line 1312 | Line 1845 | begin
1845		SQLUpdate, SQLDelete])) then
1846		result := ''
1847		else
1848	<	with Firebird30ClientAPI do
1848	>	with FFirebird30ClientAPI do
1849		begin
1850		Result := FStatementIntf.getPlan(StatusIntf,true);
1851		Check4DataBaseError;
#	Line 1346 | Line 1879 | begin
1879		TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1880		end;
1881
1882	+	function TFB30Statement.IsInBatchMode: boolean;
1883	+	begin
1884	+	Result := FBatch <> nil;
1885	+	end;
1886	+
1887	+	function TFB30Statement.HasBatchMode: boolean;
1888	+	begin
1889	+	Result := GetAttachment.HasBatchMode;
1890	+	end;
1891	+
1892	+	procedure TFB30Statement.AddToBatch;
1893	+	var BatchPB: TXPBParameterBlock;
1894	+	inMetadata: Firebird.IMessageMetadata;
1895	+
1896	+	const SixteenMB = 16 * 1024 * 1024;
1897	+	MB256 = 256* 1024 *1024;
1898	+	begin
1899	+	FBatchCompletion := nil;
1900	+	if not FPrepared then
1901	+	InternalPrepare;
1902	+	CheckHandle;
1903	+	CheckBatchModeAvailable;
1904	+	inMetadata := FSQLParams.GetMetaData;
1905	+	try
1906	+	with FFirebird30ClientAPI do
1907	+	begin
1908	+	if FBatch = nil then
1909	+	begin
1910	+	{Start Batch}
1911	+	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1912	+	with FFirebird30ClientAPI do
1913	+	try
1914	+	if FBatchRowLimit = maxint then
1915	+	FBatchBufferSize := MB256
1916	+	else
1917	+	begin
1918	+	FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf);
1919	+	Check4DatabaseError;
1920	+	if FBatchBufferSize < SixteenMB then
1921	+	FBatchBufferSize := SixteenMB;
1922	+	if FBatchBufferSize > MB256 {assumed limit} then
1923	+	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1924	+	end;
1925	+	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1926	+	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1927	+	FBatch := FStatementIntf.createBatch(StatusIntf,
1928	+	inMetadata,
1929	+	BatchPB.getDataLength,
1930	+	BatchPB.getBuffer);
1931	+	Check4DataBaseError;
1932	+
1933	+	finally
1934	+	BatchPB.Free;
1935	+	end;
1936	+	FBatchRowCount := 0;
1937	+	FBatchBufferUsed := 0;
1938	+	end;
1939	+
1940	+	Inc(FBatchRowCount);
1941	+	Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf));
1942	+	Check4DataBaseError;
1943	+	if FBatchBufferUsed > FBatchBufferSize then
1944	+	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1945	+	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1946	+	[FBatchRowCount,FBatchBufferSize]));
1947	+
1948	+	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1949	+	Check4DataBaseError
1950	+	end;
1951	+	finally
1952	+	if inMetadata <> nil then
1953	+	inMetadata.release;
1954	+	end;
1955	+	end;
1956	+
1957	+	function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1958	+	): IBatchCompletion;
1959	+
1960	+	procedure Check4BatchCompletionError(bc: IBatchCompletion);
1961	+	var status: IStatus;
1962	+	RowNo: integer;
1963	+	begin
1964	+	status := nil;
1965	+	{Raise an exception if there was an error reported in the BatchCompletion}
1966	+	if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1967	+	raise EIBInterbaseError.Create(status);
1968	+	end;
1969	+
1970	+	var cs: Firebird.IBatchCompletionState;
1971	+
1972	+	begin
1973	+	Result := nil;
1974	+	if FBatch = nil then
1975	+	IBError(ibxeNotInBatchMode,[]);
1976	+
1977	+	with FFirebird30ClientAPI do
1978	+	begin
1979	+	SavePerfStats(FBeforeStats);
1980	+	if aTransaction = nil then
1981	+	cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1982	+	else
1983	+	cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1984	+	Check4DataBaseError;
1985	+	FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1986	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1987	+	FBatch.release;
1988	+	FBatch := nil;
1989	+	Check4BatchCompletionError(FBatchCompletion);
1990	+	Result := FBatchCompletion;
1991	+	end;
1992	+	end;
1993	+
1994	+	procedure TFB30Statement.CancelBatch;
1995	+	begin
1996	+	if FBatch = nil then
1997	+	IBError(ibxeNotInBatchMode,[]);
1998	+	FBatch.release;
1999	+	FBatch := nil;
2000	+	end;
2001	+
2002	+	function TFB30Statement.GetBatchCompletion: IBatchCompletion;
2003	+	begin
2004	+	Result := FBatchCompletion;
2005	+	end;
2006	+
2007		function TFB30Statement.IsPrepared: boolean;
2008		begin
2009		Result := FStatementIntf <> nil;
2010		end;
2011
2012	+	function TFB30Statement.GetFlags: TStatementFlags;
2013	+	var flags: cardinal;
2014	+	begin
2015	+	CheckHandle;
2016	+	Result := [];
2017	+	with FFirebird30ClientAPI do
2018	+	begin
2019	+	flags := FStatementIntf.getFlags(StatusIntf);
2020	+	Check4DataBaseError;
2021	+	end;
2022	+	if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
2023	+	Result := Result + [stHasCursor];
2024	+	if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
2025	+	Result := Result + [stRepeatExecute];
2026	+	if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
2027	+	Result := Result + [stScrollable];
2028	+	end;
2029	+
2030		end.
2031

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 389 by tony, Thu Jan 20 23:33:40 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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