[ViewVC] Diff of: public/ibx/branches/udr/client/3.0/FB30Statement.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 68 by tony, Tue Oct 17 10:07:58 2017 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 94 \| Line 97 \| type
97		{SQL Var Type Data}
98		FSQLType: cardinal;
99		FSQLSubType: integer;
100	<	FSQLData: PChar; {Address of SQL Data in Message Buffer}
100	>	FSQLData: PByte; {Address of SQL Data in Message Buffer}
101		FSQLNullIndicator: PShort; {Address of null indicator}
102		FDataLength: integer;
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 GetSQLType: cardinal; override;
111		function GetSubtype: integer; override;
112	<	function GetAliasName: string; override;
113	<	function GetFieldName: string; override;
114	<	function GetOwnerName: string; override;
115	<	function GetRelationName: string; override;
112	>	function GetAliasName: AnsiString; override;
113	>	function GetFieldName: AnsiString; override;
114	>	function GetOwnerName: AnsiString; override;
115	>	function GetRelationName: AnsiString; override;
116		function GetScale: integer; override;
117		function GetCharSetID: cardinal; override;
118		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		procedure SetIsNull(Value: Boolean); override;
124		procedure SetIsNullable(Value: Boolean); override;
125	<	procedure SetSQLData(AValue: PChar; len: cardinal); override;
125	>	procedure SetSQLData(AValue: PByte; len: cardinal); override;
126		procedure SetScale(aValue: integer); override;
127		procedure SetDataLength(len: cardinal); override;
128		procedure SetSQLType(aValue: cardinal); override;
#	Line 170 \| Line 173 \| type
173
174		TIBXINPUTSQLDA = class(TIBXSQLDA)
175		private
176	<	FMessageBuffer: PChar; {Message Buffer}
176	>	FMessageBuffer: PByte; {Message Buffer}
177		FMsgLength: integer; {Message Buffer length}
178		FCurMetaData: Firebird.IMessageMetadata;
179		procedure FreeMessageBuffer;
180	<	function GetMessageBuffer: PChar;
180	>	function GetMessageBuffer: PByte;
181		function GetMetaData: Firebird.IMessageMetadata;
182		function GetModified: Boolean;
183		function GetMsgLength: integer;
184	+	procedure BuildMetadata;
185		procedure PackBuffer;
186		protected
187		procedure FreeXSQLDA; override;
#	Line 188 \| Line 192 \| type
192		procedure Changed; override;
193		function IsInputDataArea: boolean; override;
194		property MetaData: Firebird.IMessageMetadata read GetMetaData;
195	<	property MessageBuffer: PChar read GetMessageBuffer;
195	>	property MessageBuffer: PByte read GetMessageBuffer;
196		property MsgLength: integer read GetMsgLength;
197		end;
198
#	Line 197 \| Line 201 \| type
201		TIBXOUTPUTSQLDA = class(TIBXSQLDA)
202		private
203		FTransaction: TFB30Transaction; {transaction used to execute the statement}
204	<	FMessageBuffer: PChar; {Message Buffer}
204	>	FMessageBuffer: PByte; {Message Buffer}
205		FMsgLength: integer; {Message Buffer length}
206		protected
207		procedure FreeXSQLDA; override;
208		public
209		procedure Bind(aMetaData: Firebird.IMessageMetadata);
210		procedure GetData(index: integer; var aIsNull: boolean; var len: short;
211	<	var data: PChar); override;
211	>	var data: PByte); override;
212		function IsInputDataArea: boolean; override;
213	<	property MessageBuffer: PChar read FMessageBuffer;
213	>	property MessageBuffer: PByte read FMessageBuffer;
214		property MsgLength: integer read FMsgLength;
215		end;
216
#	Line 221 \| Line 225 \| type
225		destructor Destroy; override;
226		{IResultSet}
227		function FetchNext: boolean;
228	<	function GetCursorName: string;
228	>	function GetCursorName: AnsiString;
229		function GetTransaction: ITransaction; override;
230		function IsEof: boolean;
231		procedure Close;
#	Line 246 \| Line 250 \| type
250		procedure InternalClose(Force: boolean); override;
251		public
252		constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
253	<	sql: string; aSQLDialect: integer);
253	>	sql: AnsiString; aSQLDialect: integer);
254		constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
255	<	sql: string; aSQLDialect: integer; GenerateParamNames: boolean =false);
255	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false);
256		destructor Destroy; override;
257		function FetchNext: boolean;
258		property StatementIntf: Firebird.IStatement read FStatementIntf;
#	Line 257 \| Line 261 \| type
261		{IStatement}
262		function GetSQLParams: ISQLParams; override;
263		function GetMetaData: IMetaData; override;
264	<	function GetPlan: String;
264	>	function GetPlan: AnsiString;
265		function IsPrepared: boolean;
266		function CreateBlob(column: TColumnMetaData): IBlob; override;
267		function CreateArray(column: TColumnMetaData): IArray; override;
#	Line 267 \| Line 271 \| end;
271
272		implementation
273
274	<	uses IBUtils, FBMessages, FB30Blob, variants, FBArray, FB30Array;
274	>	uses IBUtils, FBMessages, FBBlob, FB30Blob, variants, FBArray, FB30Array;
275	>
276	>	const
277	>	ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
278
279		{ TIBXSQLVAR }
280
#	Line 287 \| Line 294 \| begin
294		Result := FSQLSubType;
295		end;
296
297	<	function TIBXSQLVAR.GetAliasName: string;
297	>	function TIBXSQLVAR.GetAliasName: AnsiString;
298		begin
299		with Firebird30ClientAPI do
300		begin
#	Line 296 \| Line 303 \| begin
303		end;
304		end;
305
306	<	function TIBXSQLVAR.GetFieldName: string;
306	>	function TIBXSQLVAR.GetFieldName: AnsiString;
307		begin
308		Result := FFieldName;
309		end;
310
311	<	function TIBXSQLVAR.GetOwnerName: string;
311	>	function TIBXSQLVAR.GetOwnerName: AnsiString;
312		begin
313		with Firebird30ClientAPI do
314		begin
#	Line 310 \| Line 317 \| begin
317		end;
318		end;
319
320	<	function TIBXSQLVAR.GetRelationName: string;
320	>	function TIBXSQLVAR.GetRelationName: AnsiString;
321		begin
322		Result := FRelationName;
323		end;
#	Line 337 \| Line 344 \| begin
344		else
345		result := FCharSetID;
346		end;
347	+	result := result;
348		end;
349
350		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
351		begin
352		result := CP_NONE;
353	<	with Firebird30ClientAPI do
353	>	with Statement.GetAttachment do
354		CharSetID2CodePage(GetCharSetID,result);
355		end;
356
#	Line 356 \| Line 364 \| begin
364		Result := FSQLNullIndicator <> nil;
365		end;
366
367	<	function TIBXSQLVAR.GetSQLData: PChar;
367	>	function TIBXSQLVAR.GetSQLData: PByte;
368		begin
369		Result := FSQLData;
370		end;
#	Line 388 \| Line 396 \| begin
396		FStatement.GetTransaction as TFB30Transaction,
397		GetRelationName,GetFieldName,
398		GetSubType);
399	+	(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
400		Result := FBlobMetaData;
401		end;
402
#	Line 401 \| Line 410 \| begin
410		else
411		if IsNullable then
412		FNullIndicator := 0;
413	+	Changed;
414		end;
415
416		procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
#	Line 413 \| Line 423 \| begin
423		end
424		else
425		FSQLNullIndicator := nil;
426	+	Changed;
427		end;
428
429	<	procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
429	>	procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
430		begin
431		if FOwnsSQLData then
432		FreeMem(FSQLData);
433		FSQLData := AValue;
434		FDataLength := len;
435		FOwnsSQLData := false;
436	+	Changed;
437		end;
438
439		procedure TIBXSQLVAR.SetScale(aValue: integer);
440		begin
441		FScale := aValue;
442	+	Changed;
443		end;
444
445		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 437 \| Line 450 \| begin
450		with Firebird30ClientAPI do
451		IBAlloc(FSQLData, 0, FDataLength);
452		FOwnsSQLData := true;
453	+	Changed;
454		end;
455
456		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
457		begin
458		FSQLType := aValue;
459	+	Changed;
460		end;
461
462		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
463		begin
464		FCharSetID := aValue;
465	+	Changed;
466		end;
467
468		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
#	Line 538 \| Line 554 \| begin
554		FResults.Column[i].RowChange;
555		end;
556
557	<	function TResultSet.GetCursorName: string;
557	>	function TResultSet.GetCursorName: AnsiString;
558		begin
559		IBError(ibxeNotSupported,[nil]);
560		Result := '';
#	Line 590 \| Line 606 \| begin
606		FMsgLength := 0;
607		end;
608
609	<	function TIBXINPUTSQLDA.GetMessageBuffer: PChar;
609	>	function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
610		begin
611		PackBuffer;
612		Result := FMessageBuffer;
#	Line 598 \| Line 614 \| end;
614
615		function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
616		begin
617	<	PackBuffer;
617	>	BuildMetadata;
618		Result := FCurMetaData;
619		end;
620
#	Line 608 \| Line 624 \| begin
624		Result := FMsgLength;
625		end;
626
627	<	procedure TIBXINPUTSQLDA.PackBuffer;
627	>	procedure TIBXINPUTSQLDA.BuildMetadata;
628		var Builder: Firebird.IMetadataBuilder;
629		i: integer;
630		begin
631	<	if FMsgLength > 0 then Exit;
616	<
631	>	if FCurMetaData = nil then
632		with Firebird30ClientAPI do
633		begin
634		Builder := inherited MetaData.getBuilder(StatusIntf);
#	Line 638 \| Line 653 \| begin
653		finally
654		Builder.release;
655		end;
656	+	end;
657	+	end;
658	+
659	+	procedure TIBXINPUTSQLDA.PackBuffer;
660	+	var i: integer;
661	+	begin
662	+	BuildMetadata;
663
664	+	if FMsgLength = 0 then
665	+	with Firebird30ClientAPI do
666	+	begin
667		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
668		Check4DataBaseError;
669
#	Line 647 \| Line 672 \| begin
672		for i := 0 to Count - 1 do
673		with TIBXSQLVar(Column[i]) do
674		begin
675	<	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
675	>	if not Modified then
676	>	IBError(ibxeUninitializedInputParameter,[i,Name]);
677	>
678	>	if IsNull then
679	>	FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
680	>	else
681	>	if FSQLData <> nil then
682	>	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
683		Check4DataBaseError;
684		if IsNullable then
685		begin
#	Line 712 \| Line 744 \| begin
744		else
745		IBAlloc(FSQLData, 0, FDataLength)
746		end;
747	<	SQL_VARYING: begin
747	>	SQL_VARYING:
748		IBAlloc(FSQLData, 0, FDataLength + 2);
717	–	end;
749		else
750		IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
751		end;
#	Line 728 \| Line 759 \| begin
759		FSQLNullIndicator := nil;
760		FScale := aMetaData.getScale(StatusIntf,i);
761		Check4DataBaseError;
762	<	FCharSetID := aMetaData.getCharSet(StatusIntf,i);
762	>	FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF;
763		Check4DataBaseError;
764		end;
765		end;
#	Line 802 \| Line 833 \| begin
833		FSQLNullIndicator := nil;
834		FScale := aMetaData.getScale(StatusIntf,i);
835		Check4DataBaseError;
836	<	FCharSetID := aMetaData.getCharSet(StatusIntf,i);
836	>	FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF;
837		Check4DataBaseError;
838		end;
839		end;
#	Line 810 \| Line 841 \| begin
841		end;
842
843		procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean;
844	<	var len: short; var data: PChar);
844	>	var len: short; var data: PByte);
845		begin
846		with TIBXSQLVAR(Column[index]) do
847		begin
#	Line 977 \| Line 1008 \| begin
1008		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1009		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1010		Length(FProcessedSQL),
1011	<	PChar(FProcessedSQL),
1011	>	PAnsiChar(FProcessedSQL),
1012		FSQLDialect,
1013		Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1014		end
#	Line 985 \| Line 1016 \| begin
1016		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1017		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1018		Length(FSQL),
1019	<	PChar(FSQL),
1019	>	PAnsiChar(FSQL),
1020		FSQLDialect,
1021		Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1022		Check4DataBaseError;
#	Line 1066 \| Line 1097 \| begin
1097
1098		try
1099		with Firebird30ClientAPI do
1069	–	case FSQLStatementType of
1070	–	SQLSelect:
1071	–	IBError(ibxeIsAExecuteProcedure,[]);
1072	–
1073	–	SQLExecProcedure:
1100		begin
1101	<	FStatementIntf.execute(StatusIntf,
1102	<	(aTransaction as TFB30Transaction).TransactionIntf,
1103	<	FSQLParams.MetaData,
1104	<	FSQLParams.MessageBuffer,
1105	<	FSQLRecord.MetaData,
1106	<	FSQLRecord.MessageBuffer);
1107	<	Check4DataBaseError;
1101	>	if FCollectStatistics then
1102	>	begin
1103	>	UtilIntf.getPerfCounters(StatusIntf,
1104	>	(GetAttachment as TFB30Attachment).AttachmentIntf,
1105	>	ISQL_COUNTERS,@FBeforeStats);
1106	>	Check4DataBaseError;
1107	>	end;
1108
1109	<	Result := TResults.Create(FSQLRecord);
1110	<	FSingleResults := true;
1111	<	end
1112	<	else
1113	<	FStatementIntf.execute(StatusIntf,
1114	<	(aTransaction as TFB30Transaction).TransactionIntf,
1115	<	FSQLParams.MetaData,
1116	<	FSQLParams.MessageBuffer,
1117	<	nil,
1118	<	nil);
1119	<	Check4DataBaseError;
1109	>	case FSQLStatementType of
1110	>	SQLSelect:
1111	>	IBError(ibxeIsAExecuteProcedure,[]);
1112	>
1113	>	SQLExecProcedure:
1114	>	begin
1115	>	FStatementIntf.execute(StatusIntf,
1116	>	(aTransaction as TFB30Transaction).TransactionIntf,
1117	>	FSQLParams.MetaData,
1118	>	FSQLParams.MessageBuffer,
1119	>	FSQLRecord.MetaData,
1120	>	FSQLRecord.MessageBuffer);
1121	>	Check4DataBaseError;
1122	>
1123	>	Result := TResults.Create(FSQLRecord);
1124	>	FSingleResults := true;
1125	>	end
1126	>	else
1127	>	FStatementIntf.execute(StatusIntf,
1128	>	(aTransaction as TFB30Transaction).TransactionIntf,
1129	>	FSQLParams.MetaData,
1130	>	FSQLParams.MessageBuffer,
1131	>	nil,
1132	>	nil);
1133	>	Check4DataBaseError;
1134	>	end;
1135	>	if FCollectStatistics then
1136	>	begin
1137	>	UtilIntf.getPerfCounters(StatusIntf,
1138	>	(GetAttachment as TFB30Attachment).AttachmentIntf,
1139	>	ISQL_COUNTERS, @FAfterStats);
1140	>	Check4DataBaseError;
1141	>	FStatisticsAvailable := true;
1142	>	end;
1143		end;
1144		finally
1145		if aTransaction <> FTransactionIntf then
#	Line 1118 \| Line 1167 \| begin
1167
1168		with Firebird30ClientAPI do
1169		begin
1170	+	if FCollectStatistics then
1171	+	begin
1172	+	UtilIntf.getPerfCounters(StatusIntf,
1173	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1174	+	ISQL_COUNTERS, @FBeforeStats);
1175	+	Check4DataBaseError;
1176	+	end;
1177	+
1178		FResultSet := FStatementIntf.openCursor(StatusIntf,
1179		(aTransaction as TFB30Transaction).TransactionIntf,
1180		FSQLParams.MetaData,
#	Line 1125 \| Line 1182 \| begin
1182		FSQLRecord.MetaData,
1183		0);
1184		Check4DataBaseError;
1185	+
1186	+	if FCollectStatistics then
1187	+	begin
1188	+	UtilIntf.getPerfCounters(StatusIntf,
1189	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1190	+	ISQL_COUNTERS,@FAfterStats);
1191	+	Check4DataBaseError;
1192	+	FStatisticsAvailable := true;
1193	+	end;
1194		end;
1195		Inc(FCursorSeqNo);
1196		FSingleResults := false;
#	Line 1169 \| Line 1235 \| begin
1235		if not Force then Check4DataBaseError;
1236		end;
1237		finally
1238	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1238	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then
1239		RemoveMonitor(FSQLRecord.FTransaction);
1240		FOpen := False;
1241		FExecTransactionIntf := nil;
#	Line 1180 \| Line 1246 \| begin
1246		end;
1247
1248		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1249	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1249	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1250		begin
1251		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1252		FSQLParams := TIBXINPUTSQLDA.Create(self);
#	Line 1189 \| Line 1255 \| begin
1255		end;
1256
1257		constructor TFB30Statement.CreateWithParameterNames(
1258	<	Attachment: TFB30Attachment; Transaction: ITransaction; sql: string;
1258	>	Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1259		aSQLDialect: integer; GenerateParamNames: boolean);
1260		begin
1261		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
#	Line 1262 \| Line 1328 \| begin
1328		Result := TMetaData(GetInterface(1));
1329		end;
1330
1331	<	function TFB30Statement.GetPlan: String;
1331	>	function TFB30Statement.GetPlan: AnsiString;
1332		begin
1333		CheckHandle;
1334		if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,

Diff Legend

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

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents): Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs. Revision 68 by tony, Tue Oct 17 10:07:58 2017 UTC

Diff Legend

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 68 by tony, Tue Oct 17 10:07:58 2017 UTC