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.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 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, FBBLob, 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';
#	Line 290 | 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 299 | 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 313 | 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 340 | 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 359 | 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 418 | 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 442 | 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 543 | 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 595 | 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 603 | Line 614 | end;
614
615		function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
616		begin
617	<	PackBuffer;
617	>	BuildMetadata;
618		Result := FCurMetaData;
619		end;
620
#	Line 613 | 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;
621	<
631	>	if FCurMetaData = nil then
632		with Firebird30ClientAPI do
633		begin
634		Builder := inherited MetaData.getBuilder(StatusIntf);
#	Line 643 | 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 652 | Line 672 | begin
672		for i := 0 to Count - 1 do
673		with TIBXSQLVar(Column[i]) do
674		begin
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
#	Line 735 | 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 809 | 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 817 | 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 984 | 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 992 | 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 1122 | Line 1146 | begin
1146		RemoveMonitor(aTransaction as TFB30Transaction);
1147		end;
1148		FExecTransactionIntf := aTransaction;
1149	+	FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1150	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1151		SignalActivity;
1152		Inc(FChangeSeqNo);
1153		end;
#	Line 1211 | Line 1237 | begin
1237		if not Force then Check4DataBaseError;
1238		end;
1239		finally
1240	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1240	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then
1241		RemoveMonitor(FSQLRecord.FTransaction);
1242		FOpen := False;
1243		FExecTransactionIntf := nil;
#	Line 1222 | Line 1248 | begin
1248		end;
1249
1250		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1251	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1251	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1252		begin
1253		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1254		FSQLParams := TIBXINPUTSQLDA.Create(self);
#	Line 1231 | Line 1257 | begin
1257		end;
1258
1259		constructor TFB30Statement.CreateWithParameterNames(
1260	<	Attachment: TFB30Attachment; Transaction: ITransaction; sql: string;
1260	>	Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1261		aSQLDialect: integer; GenerateParamNames: boolean);
1262		begin
1263		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
#	Line 1281 | Line 1307 | begin
1307		FBOF := false;
1308		result := true;
1309		end;
1310	+	if FCollectStatistics then
1311	+	begin
1312	+	UtilIntf.getPerfCounters(StatusIntf,
1313	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1314	+	ISQL_COUNTERS,@FAfterStats);
1315	+	Check4DataBaseError;
1316	+	FStatisticsAvailable := true;
1317	+	end;
1318		end;
1319		FSQLRecord.RowChange;
1320		SignalActivity;
#	Line 1304 | Line 1338 | begin
1338		Result := TMetaData(GetInterface(1));
1339		end;
1340
1341	<	function TFB30Statement.GetPlan: String;
1341	>	function TFB30Statement.GetPlan: AnsiString;
1342		begin
1343		CheckHandle;
1344		if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,

Diff Legend

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