ViewVC Help

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

root/public/ibx/trunk/fbintf/client/3.0/FB30Statement.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 401 by tony, Mon Jan 10 10:13:17 2022 UTC vs.
Revision 402 by tony, Mon Aug 1 10:07:24 2022 UTC

#	Line 88 | Line 88 | type
88		FStatement: TFB30Statement;
89		FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob;             {Cache references}
91	–	FArray: IArray;
91		FNullIndicator: short;
92		FOwnsSQLData: boolean;
93		FBlobMetaData: IBlobMetaData;
#	Line 99 | Line 98 | type
98		FSQLSubType: integer;
99		FSQLData: PByte; {Address of SQL Data in Message Buffer}
100		FSQLNullIndicator: PShort; {Address of null indicator}
101	<	FDataLength: integer;
102	<	FMetadataSize: integer;
101	>	FDataLength: cardinal;
102	>	FMetadataSize: cardinal;
103		FNullable: boolean;
104		FScale: integer;
105		FCharSetID: cardinal;
#	Line 117 | Line 116 | type
116		function GetRelationName: AnsiString;  override;
117		function GetScale: integer; override;
118		function GetCharSetID: cardinal; override;
120	–	function GetCodePage: TSystemCodePage; override;
121	–	function GetCharSetWidth: integer; override;
119		function GetIsNull: Boolean;   override;
120		function GetIsNullable: boolean; override;
121		function GetSQLData: PByte;  override;
122		function GetDataLength: cardinal; override;
123		function GetSize: cardinal; override;
127	–	function GetAttachment: IAttachment; override;
124		function GetDefaultTextSQLType: cardinal; override;
125		procedure SetIsNull(Value: Boolean); override;
126		procedure SetIsNullable(Value: Boolean);  override;
127	<	procedure SetSQLData(AValue: PByte; len: cardinal); override;
128	<	procedure SetScale(aValue: integer); override;
129	<	procedure SetDataLength(len: cardinal); override;
134	<	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		procedure SetMetaSize(aValue: cardinal); override;
132		public
#	Line 141 | Line 136 | type
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 159 | Line 155 | type
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		function CanChangeMetaData: boolean; override;
177	–	property MetaData: Firebird.IMessageMetadata read FMetaData;
178		property Count: Integer read FCount write SetCount;
179		property Statement: TFB30Statement read FStatement;
180		end;
#	Line 183 | Line 183 | type
183
184		TIBXINPUTSQLDA = class(TIBXSQLDA)
185		private
186	–	FMessageBuffer: PByte; {Message Buffer}
187	–	FMsgLength: integer; {Message Buffer length}
186		FCurMetaData: Firebird.IMessageMetadata;
189	–	procedure FreeMessageBuffer;
187		procedure FreeCurMetaData;
188		function GetMessageBuffer: PByte;
192	–	function GetMetaData: Firebird.IMessageMetadata;
189		function GetModified: Boolean;
190		function GetMsgLength: integer;
191		procedure BuildMetadata;
196	–	procedure PackBuffer;
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;
206	–	property MetaData: Firebird.IMessageMetadata read GetMetaData;
204		property MessageBuffer: PByte read GetMessageBuffer;
205		property MsgLength: integer read GetMsgLength;
206		end;
#	Line 213 | Line 210 | type
210		TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211		private
212		FTransaction: TFB30Transaction; {transaction used to execute the statement}
216	–	FMessageBuffer: PByte; {Message Buffer}
217	–	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;
#	Line 244 | Line 239 | type
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;
247	–	function GetTransaction: ITransaction; override;
242		function IsBof: boolean;
243		function IsEof: boolean;
244		procedure Close;
#	Line 256 | Line 250 | type
250		private
251		FCompletionState: Firebird.IBatchCompletionState;
252		FFirebird30ClientAPI: TFB30ClientAPI;
253	+	FStatus: IStatus;
254		public
255		constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
256		destructor Destroy; override;
#	Line 290 | Line 285 | type
285		procedure CheckHandle; override;
286		procedure CheckBatchModeAvailable;
287		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
288	+	function GetStatementIntf: IStatement; override;
289		procedure InternalPrepare(CursorName: AnsiString=''); override;
290		function InternalExecute(aTransaction: ITransaction): IResults; override;
291		function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
#	Line 307 | Line 303 | type
303		destructor Destroy; override;
304		function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
305		property StatementIntf: Firebird.IStatement read FStatementIntf;
306	+	property SQLParams: TIBXINPUTSQLDA read FSQLParams;
307	+	property SQLRecord: TIBXOUTPUTSQLDA read FSQLRecord;
308
309		public
310		{IStatement}
#	Line 344 | Line 342 | begin
342		inherited Create;
343		FFirebird30ClientAPI := api;
344		FCompletionState := cs;
345	+	FStatus := api.GetStatus.clone;
346		end;
347
348		destructor TBatchCompletion.Destroy;
#	Line 361 | Line 360 | function TBatchCompletion.getErrorStatus
360		var i: integer;
361		upcount: cardinal;
362		state: integer;
364	–	FBStatus: Firebird.IStatus;
363		begin
364		Result := false;
365		RowNo := -1;
368	–	FBStatus := nil;
366		with FFirebird30ClientAPI do
367		begin
368		upcount := FCompletionState.getSize(StatusIntf);
#	Line 376 | Line 373 | begin
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);
382	<	Check4DataBaseError;
383	<	except
384	<	FBStatus.dispose;
385	<	raise
386	<	end;
387	<	status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
388	<	Format(SBatchCompletionError,[RowNo]));
389	<	status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
376	>	FCompletionState.getStatus(StatusIntf,(FStatus as TFB30Status).GetStatus,i);
377	>	Check4DataBaseError;
378	>	status := FStatus;
379		Result := true;
380		break;
381		end;
#	Line 431 | Line 420 | begin
420		status := MasterIntf.getStatus;
421		FCompletionState.getStatus(StatusIntf,status,updateNo);
422		Check4DataBaseError;
423	<	Result := FormatFBStatus(status);
423	>	Result := FormatStatus(status);
424		end;
425		end;
426
#	Line 490 | Line 479 | begin
479		FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
480		Check4DataBaseError;
481		end;
482	+	if Name = '' then
483	+	Name := FFieldName;
484		end;
485
486		procedure TIBXSQLVAR.ColumnSQLDataInit;
#	Line 537 | Line 528 | begin
528		end;
529
530		function TIBXSQLVAR.GetAliasName: AnsiString;
531	+	var metadata: Firebird.IMessageMetadata;
532		begin
533	<	with FFirebird30ClientAPI do
534	<	begin
535	<	result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
536	<	Check4DataBaseError;
533	>	metadata := TIBXSQLDA(Parent).GetMetaData;
534	>	try
535	>	with FFirebird30ClientAPI do
536	>	begin
537	>	result := strpas(metaData.getAlias(StatusIntf,Index));
538	>	Check4DataBaseError;
539	>	end;
540	>	finally
541	>	metadata.release;
542		end;
543		end;
544
#	Line 551 | Line 548 | begin
548		end;
549
550		function TIBXSQLVAR.GetOwnerName: AnsiString;
551	+	var metadata: Firebird.IMessageMetadata;
552		begin
553	<	with FFirebird30ClientAPI do
554	<	begin
555	<	result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
556	<	Check4DataBaseError;
553	>	metadata := TIBXSQLDA(Parent).GetMetaData;
554	>	try
555	>	with FFirebird30ClientAPI do
556	>	begin
557	>	result := strpas(metaData.getOwner(StatusIntf,Index));
558	>	Check4DataBaseError;
559	>	end;
560	>	finally
561	>	metadata.release;
562		end;
563		end;
564
#	Line 590 | Line 593 | begin
593		end;
594		end;
595
593	–	function TIBXSQLVAR.GetCodePage: TSystemCodePage;
594	–	begin
595	–	result := CP_NONE;
596	–	with Statement.GetAttachment do
597	–	CharSetID2CodePage(GetCharSetID,result);
598	–	end;
599	–
600	–	function TIBXSQLVAR.GetCharSetWidth: integer;
601	–	begin
602	–	result := 1;
603	–	with Statement.GetAttachment DO
604	–	CharSetWidth(GetCharSetID,result);
605	–	end;
606	–
596		function TIBXSQLVAR.GetIsNull: Boolean;
597		begin
598		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 629 | Line 618 | begin
618		Result := FMetadataSize;
619		end;
620
632	–	function TIBXSQLVAR.GetAttachment: IAttachment;
633	–	begin
634	–	Result := FStatement.GetAttachment;
635	–	end;
636	–
621		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
622		begin
623		if GetSQLType <> SQL_ARRAY then
624		IBError(ibxeInvalidDataConversion,[nil]);
625
626		if FArrayMetaData = nil then
627	<	FArrayMetaData := TFB30ArrayMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
628	<	FStatement.GetTransaction as TFB30Transaction,
627	>	FArrayMetaData := TFB30ArrayMetaData.Create(GetAttachment as TFB30Attachment,
628	>	GetTransaction as TFB30Transaction,
629		GetRelationName,GetFieldName);
630		Result := FArrayMetaData;
631		end;
#	Line 652 | Line 636 | begin
636		IBError(ibxeInvalidDataConversion,[nil]);
637
638		if FBlobMetaData = nil then
639	<	FBlobMetaData := TFB30BlobMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
640	<	FStatement.GetTransaction as TFB30Transaction,
639	>	FBlobMetaData := TFB30BlobMetaData.Create(GetAttachment as TFB30Attachment,
640	>	GetTransaction as TFB30Transaction,
641		GetRelationName,GetFieldName,
642		GetSubType);
643		(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
#	Line 696 | Line 680 | begin
680		Changed;
681		end;
682
683	<	procedure TIBXSQLVAR.SetScale(aValue: integer);
683	>	procedure TIBXSQLVAR.InternalSetScale(aValue: integer);
684		begin
685		FScale := aValue;
686		Changed;
687		end;
688
689	<	procedure TIBXSQLVAR.SetDataLength(len: cardinal);
689	>	procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal);
690		begin
691		if not FOwnsSQLData then
692		FSQLData := nil;
#	Line 713 | Line 697 | begin
697		Changed;
698		end;
699
700	<	procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
700	>	procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
701		begin
718	–	if (FSQLType <> aValue) and not CanChangeSQLType then
719	–	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
702		FSQLType := aValue;
703		Changed;
704		end;
#	Line 750 | Line 732 | procedure TIBXSQLVAR.RowChange;
732		begin
733		inherited;
734		FBlob := nil;
753	–	FArray := nil;
735		end;
736
737		procedure TIBXSQLVAR.FreeSQLData;
#	Line 761 | Line 742 | begin
742		FOwnsSQLData := true;
743		end;
744
745	<	function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
745	>	function TIBXSQLVAR.GetAsArray: IArray;
746		begin
747		if SQLType <> SQL_ARRAY then
748		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 770 | Line 751 | begin
751		Result := nil
752		else
753		begin
754	<	if FArray = nil then
755	<	FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
756	<	TIBXSQLDA(Parent).GetTransaction,
757	<	GetArrayMetaData,Array_ID);
758	<	Result := FArray;
754	>	if FArrayIntf = nil then
755	>	FArrayIntf := TFB30Array.Create(GetAttachment as TFB30Attachment,
756	>	GetTransaction as TFB30Transaction,
757	>	GetArrayMetaData,PISC_QUAD(SQLData)^);
758	>	Result := FArrayIntf;
759		end;
760		end;
761
#	Line 789 | Line 770 | begin
770		if IsNull then
771		Result := nil
772		else
773	<	Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
774	<	TIBXSQLDA(Parent).GetTransaction,
773	>	Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
774	>	GetTransaction as TFB30Transaction,
775		GetBlobMetaData,
776		Blob_ID,BPB);
777		FBlob := Result;
#	Line 799 | Line 780 | end;
780
781		function TIBXSQLVAR.CreateBlob: IBlob;
782		begin
783	<	Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
784	<	FStatement.GetTransaction as TFB30Transaction,
783	>	Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
784	>	GetTransaction as TFB30Transaction,
785		GetSubType,GetCharSetID,nil);
786		end;
787
#	Line 879 | Line 860 | begin
860		Result := FResults.FStatement.FCursor;
861		end;
862
882	–	function TResultSet.GetTransaction: ITransaction;
883	–	begin
884	–	Result := FResults.FTransaction;
885	–	end;
886	–
863		function TResultSet.IsBof: boolean;
864		begin
865		Result := FResults.FStatement.FBof;
#	Line 915 | Line 891 | begin
891		end;
892		end;
893
918	–	procedure TIBXINPUTSQLDA.FreeMessageBuffer;
919	–	begin
920	–	if FMessageBuffer <> nil then
921	–	begin
922	–	FreeMem(FMessageBuffer);
923	–	FMessageBuffer := nil;
924	–	end;
925	–	FMsgLength := 0;
926	–	end;
927	–
894		procedure TIBXINPUTSQLDA.FreeCurMetaData;
895		begin
896		if FCurMetaData <> nil then
#	Line 944 | Line 910 | function TIBXINPUTSQLDA.GetMetaData: Fir
910		begin
911		BuildMetadata;
912		Result := FCurMetaData;
913	+	if Result <> nil then
914	+	Result.addRef;
915		end;
916
917		function TIBXINPUTSQLDA.GetMsgLength: integer;
#	Line 955 | Line 923 | end;
923		procedure TIBXINPUTSQLDA.BuildMetadata;
924		var Builder: Firebird.IMetadataBuilder;
925		i: integer;
926	+	version: NativeInt;
927		begin
928		if (FCurMetaData = nil) and (Count > 0) then
929		with FFirebird30ClientAPI do
#	Line 965 | Line 934 | begin
934		for i := 0 to Count - 1 do
935		with TIBXSQLVar(Column[i]) do
936		begin
937	<	Builder.setType(StatusIntf,i,FSQLType+1);
937	>	version := Builder.vtable.version;
938	>	if version >= 4 then
939	>	{Firebird 4 or later}
940	>	begin
941	>	Builder.setField(StatusIntf,i,PAnsiChar(Name));
942	>	Check4DataBaseError;
943	>	Builder.setAlias(StatusIntf,i,PAnsiChar(Name));
944	>	Check4DataBaseError;
945	>	end;
946	>	Builder.setType(StatusIntf,i,FSQLType);
947		Check4DataBaseError;
948		Builder.setSubType(StatusIntf,i,FSQLSubType);
949		Check4DataBaseError;
#	Line 997 | Line 975 | end;
975		procedure TIBXINPUTSQLDA.PackBuffer;
976		var i: integer;
977		P: PByte;
978	+	MsgLen: cardinal;
979	+	aNullIndicator: short;
980		begin
981		BuildMetadata;
982
983		if (FMsgLength = 0) and (FCurMetaData <> nil) then
984		with FFirebird30ClientAPI do
985		begin
986	<	FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
986	>	MsgLen := FCurMetaData.getMessageLength(StatusIntf);
987		Check4DataBaseError;
988
989	<	IBAlloc(FMessageBuffer,0,FMsgLength);
989	>	AllocMessageBuffer(MsgLen);
990
991		for i := 0 to Count - 1 do
992		with TIBXSQLVar(Column[i]) do
#	Line 1037 | Line 1017 | begin
1017		begin
1018		Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
1019		Check4DataBaseError;
1020	+	end
1021	+	else
1022	+	begin
1023	+	aNullIndicator := 0;
1024	+	Move(aNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(aNullIndicator));
1025		end;
1026		end;
1027		end;
#	Line 1046 | Line 1031 | procedure TIBXINPUTSQLDA.FreeXSQLDA;
1031		begin
1032		inherited FreeXSQLDA;
1033		FreeCurMetaData;
1049	–	FreeMessageBuffer;
1034		end;
1035
1036		constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
#	Line 1055 | Line 1039 | begin
1039		FMessageBuffer := nil;
1040		end;
1041
1042	+	constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI);
1043	+	begin
1044	+	inherited Create(api);
1045	+	FMessageBuffer := nil;
1046	+	end;
1047	+
1048		destructor TIBXINPUTSQLDA.Destroy;
1049		begin
1050		FreeXSQLDA;
#	Line 1065 | Line 1055 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1055		var i: integer;
1056		begin
1057		FMetaData := aMetaData;
1058	+	FMetaData.AddRef;
1059		with FFirebird30ClientAPI do
1060		begin
1061		Count := aMetadata.getCount(StatusIntf);
#	Line 1107 | Line 1098 | end;
1098
1099		{ TIBXOUTPUTSQLDA }
1100
1101	<	procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
1101	>	function TIBXOUTPUTSQLDA.GetTransaction: ITransaction;
1102		begin
1103	<	inherited FreeXSQLDA;
1104	<	FreeMem(FMessageBuffer);
1105	<	FMessageBuffer := nil;
1106	<	FMsgLength := 0;
1103	>	if FTransaction <> nil then
1104	>	Result := FTransaction
1105	>	else
1106	>	Result := inherited GetTransaction;
1107		end;
1108
1109		procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
1110		var i: integer;
1111	+	MsgLen: cardinal;
1112		begin
1113		FMetaData := aMetaData;
1114	+	FMetaData.AddRef;
1115		with FFirebird30ClientAPI do
1116		begin
1117	<	Count := metadata.getCount(StatusIntf);
1117	>	Count := aMetaData.getCount(StatusIntf);
1118		Check4DataBaseError;
1119		Initialize;
1120
1121	<	FMsgLength := metaData.getMessageLength(StatusIntf);
1121	>	MsgLen := aMetaData.getMessageLength(StatusIntf);
1122		Check4DataBaseError;
1123	<	IBAlloc(FMessageBuffer,0,FMsgLength);
1123	>	AllocMessageBuffer(MsgLen);
1124
1125		for i := 0 to Count - 1 do
1126		with TIBXSQLVar(Column[i]) do
1127		begin
1128		InitColumnMetaData(aMetaData);
1129	<	FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1129	>	FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1130		Check4DataBaseError;
1131		if FNullable then
1132		begin
#	Line 1143 | Line 1136 | begin
1136		else
1137		FSQLNullIndicator := nil;
1138		FBlob := nil;
1139	<	FArray := nil;
1139	>	FArrayIntf := nil;
1140		end;
1141		end;
1142		SetUniqueRelationName;
#	Line 1181 | Line 1174 | begin
1174		//  writeln('Creating ',ClassName);
1175		end;
1176
1177	+	constructor TIBXSQLDA.Create(api: IFirebirdAPI);
1178	+	begin
1179	+	inherited Create;
1180	+	FStatement := nil;
1181	+	FSize := 0;
1182	+	FFirebird30ClientAPI := api as TFB30ClientAPI;
1183	+	end;
1184	+
1185		destructor TIBXSQLDA.Destroy;
1186		begin
1187		FreeXSQLDA;
#	Line 1196 | Line 1197 | end;
1197		function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
1198		begin
1199		Result := false;
1200	+	if FStatement <> nil then
1201		case Request of
1202		ssPrepared:
1203		Result := FStatement.IsPrepared;
1204
1205		ssExecuteResults:
1206	<	Result :=FStatement.FSingleResults;
1206	>	Result := FStatement.FSingleResults;
1207
1208		ssCursorOpen:
1209		Result := FStatement.FOpen;
#	Line 1219 | Line 1221 | begin
1221		Result := FCount;
1222		end;
1223
1222	–	function TIBXSQLDA.GetTransaction: TFB30Transaction;
1223	–	begin
1224	–	Result := FStatement.GetTransaction as TFB30Transaction;
1225	–	end;
1226	–
1224		procedure TIBXSQLDA.Initialize;
1225		begin
1226		if FMetaData <> nil then
#	Line 1232 | Line 1229 | end;
1229
1230		function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
1231		begin
1232	<	Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
1232	>	Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo);
1233		if Result then
1234		ChangeSeqNo := FStatement.ChangeSeqNo;
1235		end;
#	Line 1258 | Line 1255 | begin
1255		end;
1256		end;
1257
1258	+	procedure TIBXSQLDA.AllocMessageBuffer(len: integer);
1259	+	begin
1260	+	with FFirebird30ClientAPI do
1261	+	IBAlloc(FMessageBuffer,0,len);
1262	+	FMsgLength := len;
1263	+	end;
1264	+
1265	+	procedure TIBXSQLDA.FreeMessageBuffer;
1266	+	begin
1267	+	if FMessageBuffer <> nil then
1268	+	begin
1269	+	FreeMem(FMessageBuffer);
1270	+	FMessageBuffer := nil;
1271	+	end;
1272	+	FMsgLength := 0;
1273	+	end;
1274	+
1275	+	function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata;
1276	+	begin
1277	+	Result := FMetadata;
1278	+	if Result <> nil then
1279	+	Result.addRef;
1280	+	end;
1281	+
1282		function TIBXSQLDA.GetTransactionSeqNo: integer;
1283		begin
1284		Result := FTransactionSeqNo;
#	Line 1276 | Line 1297 | begin
1297		FCount := 0;
1298		SetLength(FColumnList,0);
1299		FSize := 0;
1300	+	FreeMessageBuffer;
1301		end;
1302
1303		function TIBXSQLDA.GetStatement: IStatement;
#	Line 1285 | Line 1307 | end;
1307
1308		function TIBXSQLDA.GetPrepareSeqNo: integer;
1309		begin
1310	<	Result := FStatement.FPrepareSeqNo;
1310	>	if FStatement = nil then
1311	>	Result := 0
1312	>	else
1313	>	Result := FStatement.FPrepareSeqNo;
1314		end;
1315
1316		{ TFB30Statement }
#	Line 1325 | Line 1350 | begin
1350		end;
1351		end;
1352
1353	+	function TFB30Statement.GetStatementIntf: IStatement;
1354	+	begin
1355	+	Result := self;
1356	+	end;
1357	+
1358		procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1359		var GUID : TGUID;
1360	+	metadata: Firebird.IMessageMetadata;
1361		begin
1362		if FPrepared then
1363		Exit;
#	Line 1387 | Line 1418 | begin
1418		SQLExecProcedure:
1419		begin
1420		{set up input sqlda}
1421	<	FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1421	>	metadata := FStatementIntf.getInputMetadata(StatusIntf);
1422		Check4DataBaseError;
1423	+	try
1424	+	FSQLParams.Bind(metadata);
1425	+	finally
1426	+	metadata.release;
1427	+	end;
1428
1429		{setup output sqlda}
1430		if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1431		SQLExecProcedure] then
1432	<	FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1433	<	Check4DataBaseError;
1432	>	begin
1433	>	metadata := FStatementIntf.getOutputMetadata(StatusIntf);
1434	>	Check4DataBaseError;
1435	>	try
1436	>	FSQLRecord.Bind(metadata);
1437	>	finally
1438	>	metadata.release;
1439	>	end;
1440	>	end;
1441		end;
1442		end;
1443		end;
#	Line 1428 | Line 1471 | end;
1471		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1472
1473		procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1474	+	var inMetadata: Firebird.IMessageMetaData;
1475		begin
1476		with FFirebird30ClientAPI do
1477		begin
1478		SavePerfStats(FBeforeStats);
1479	<	FStatementIntf.execute(StatusIntf,
1480	<	(aTransaction as TFB30Transaction).TransactionIntf,
1481	<	FSQLParams.MetaData,
1482	<	FSQLParams.MessageBuffer,
1483	<	outMetaData,
1484	<	outBuffer);
1485	<	Check4DataBaseError;
1479	>	inMetadata := FSQLParams.GetMetaData;
1480	>	try
1481	>	FStatementIntf.execute(StatusIntf,
1482	>	(aTransaction as TFB30Transaction).TransactionIntf,
1483	>	inMetaData,
1484	>	FSQLParams.MessageBuffer,
1485	>	outMetaData,
1486	>	outBuffer);
1487	>	Check4DataBaseError;
1488	>	finally
1489	>	if inMetadata <> nil then
1490	>	inMetadata.release;
1491	>	end;
1492		FStatisticsAvailable := SavePerfStats(FAfterStats);
1493		end;
1494		end;
1495
1496		var Cursor: IResultSet;
1497	+	outMetadata: Firebird.IMessageMetaData;
1498
1499		begin
1500		Result := nil;
#	Line 1480 | Line 1531 | begin
1531
1532		SQLExecProcedure:
1533		begin
1534	<	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1535	<	Result := TResults.Create(FSQLRecord);
1536	<	FSingleResults := true;
1534	>	outMetadata := FSQLRecord.GetMetaData;
1535	>	try
1536	>	ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer);
1537	>	Result := TResults.Create(FSQLRecord);
1538	>	FSingleResults := true;
1539	>	finally
1540	>	if outMetadata <> nil then
1541	>	outMetadata.release;
1542	>	end;
1543		end;
1544
1545		else
#	Line 1503 | Line 1560 | end;
1560		function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1561		Scrollable: boolean): IResultSet;
1562		var flags: cardinal;
1563	+	inMetadata,
1564	+	outMetadata: Firebird.IMessageMetadata;
1565		begin
1566		flags := 0;
1567		if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
#	Line 1531 | Line 1590 | begin
1590		Check4DataBaseError;
1591		end;
1592
1593	<	FResultSet := FStatementIntf.openCursor(StatusIntf,
1593	>	inMetadata := FSQLParams.GetMetaData;
1594	>	outMetadata := FSQLRecord.GetMetaData;
1595	>	try
1596	>	FResultSet := FStatementIntf.openCursor(StatusIntf,
1597		(aTransaction as TFB30Transaction).TransactionIntf,
1598	<	FSQLParams.MetaData,
1598	>	inMetaData,
1599		FSQLParams.MessageBuffer,
1600	<	FSQLRecord.MetaData,
1600	>	outMetaData,
1601		flags);
1602	<	Check4DataBaseError;
1602	>	Check4DataBaseError;
1603	>	finally
1604	>	if inMetadata <> nil then
1605	>	inMetadata.release;
1606	>	if outMetadata <> nil then
1607	>	outMetadata.release;
1608	>	end;
1609
1610		if FCollectStatistics then
1611		begin
#	Line 1662 | Line 1730 | function TFB30Statement.Fetch(FetchType:
1730		): boolean;
1731		var fetchResult: integer;
1732		begin
1733	<	result := false;
1733	>	result := false;
1734		if not FOpen then
1735		IBError(ibxeSQLClosed, [nil]);
1736
#	Line 1675 | Line 1743 | begin
1743		IBError(ibxeEOF,[nil]);
1744		{ Go to the next record... }
1745		fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1746	+	Check4DataBaseError;
1747		if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1748		begin
1749		FBOF := false;
#	Line 1689 | Line 1758 | begin
1758		IBError(ibxeBOF,[nil]);
1759		{ Go to the next record... }
1760		fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1761	+	Check4DataBaseError;
1762		if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1763		begin
1764		FBOF := true;
#	Line 1698 | Line 1768 | begin
1768		end;
1769
1770		ftFirst:
1771	<	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1771	>	begin
1772	>	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1773	>	Check4DataBaseError;
1774	>	end;
1775
1776		ftLast:
1777	<	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1777	>	begin
1778	>	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1779	>	Check4DataBaseError;
1780	>	end;
1781
1782		ftAbsolute:
1783	<	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1783	>	begin
1784	>	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1785	>	Check4DataBaseError;
1786	>	end;
1787
1788		ftRelative:
1789	<	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1789	>	begin
1790	>	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1791	>	Check4DataBaseError;
1792	>	end;
1793		end;
1794
1713	–	Check4DataBaseError;
1795		if fetchResult <> Firebird.IStatus.RESULT_OK then
1796		exit; {result = false}
1797
#	Line 1804 | Line 1885 | end;
1885
1886		procedure TFB30Statement.AddToBatch;
1887		var BatchPB: TXPBParameterBlock;
1888	+	inMetadata: Firebird.IMessageMetadata;
1889
1890		const SixteenMB = 16 * 1024 * 1024;
1891	+	MB256 = 256* 1024 *1024;
1892		begin
1893		FBatchCompletion := nil;
1894		if not FPrepared then
1895		InternalPrepare;
1896		CheckHandle;
1897		CheckBatchModeAvailable;
1898	<	with FFirebird30ClientAPI do
1899	<	begin
1900	<	if FBatch = nil then
1898	>	inMetadata := FSQLParams.GetMetaData;
1899	>	try
1900	>	with FFirebird30ClientAPI do
1901		begin
1902	<	{Start Batch}
1903	<	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1904	<	with FFirebird30ClientAPI do
1905	<	try
1906	<	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1907	<	Check4DatabaseError;
1908	<	if FBatchBufferSize < SixteenMB then
1909	<	FBatchBufferSize := SixteenMB;
1910	<	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1911	<	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1912	<
1913	<	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1914	<	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1915	<	FBatch := FStatementIntf.createBatch(StatusIntf,
1916	<	FSQLParams.MetaData,
1917	<	BatchPB.getDataLength,
1918	<	BatchPB.getBuffer);
1919	<	Check4DataBaseError;
1902	>	if FBatch = nil then
1903	>	begin
1904	>	{Start Batch}
1905	>	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1906	>	with FFirebird30ClientAPI do
1907	>	try
1908	>	if FBatchRowLimit = maxint then
1909	>	FBatchBufferSize := MB256
1910	>	else
1911	>	begin
1912	>	FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf);
1913	>	Check4DatabaseError;
1914	>	if FBatchBufferSize < SixteenMB then
1915	>	FBatchBufferSize := SixteenMB;
1916	>	if FBatchBufferSize > MB256 {assumed limit} then
1917	>	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1918	>	end;
1919	>	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1920	>	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1921	>	FBatch := FStatementIntf.createBatch(StatusIntf,
1922	>	inMetadata,
1923	>	BatchPB.getDataLength,
1924	>	BatchPB.getBuffer);
1925	>	Check4DataBaseError;
1926
1927	<	finally
1928	<	BatchPB.Free;
1927	>	finally
1928	>	BatchPB.Free;
1929	>	end;
1930	>	FBatchRowCount := 0;
1931	>	FBatchBufferUsed := 0;
1932		end;
1841	–	FBatchRowCount := 0;
1842	–	FBatchBufferUsed := 0;
1843	–	end;
1933
1934	<	Inc(FBatchRowCount);
1935	<	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1936	<	Check4DataBaseError;
1937	<	if FBatchBufferUsed > FBatchBufferSize then
1938	<	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1939	<	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1940	<	[FBatchRowCount,FBatchBufferSize]));
1934	>	Inc(FBatchRowCount);
1935	>	Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf));
1936	>	Check4DataBaseError;
1937	>	if FBatchBufferUsed > FBatchBufferSize then
1938	>	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1939	>	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1940	>	[FBatchRowCount,FBatchBufferSize]));
1941
1942	<	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1943	<	Check4DataBaseError
1942	>	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1943	>	Check4DataBaseError
1944	>	end;
1945	>	finally
1946	>	if inMetadata <> nil then
1947	>	inMetadata.release;
1948		end;
1949		end;
1950

Diff Legend

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