ViewVC Help

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

root/public/ibx/branches/journaling/fbintf/client/2.5/FB25Statement.pas

Comparing ibx/trunk/fbintf/client/2.5/FB25Statement.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC

#	Line 60 | Line 60
60		{                                                                        }
61		{************************************************************************}
62		unit FB25Statement;
63	+	{$IFDEF MSWINDOWS}
64	+	{$DEFINE WINDOWS}
65	+	{$ENDIF}
66
67		{$IFDEF FPC}
68	<	{$mode objfpc}{$H+}
68	>	{$mode delphi}
69		{$codepage UTF8}
70		{$interfaces COM}
71		{$ENDIF}
#	Line 128 | Line 131 | type
131		protected
132		function GetSQLType: cardinal; override;
133		function GetSubtype: integer; override;
134	<	function GetAliasName: string;  override;
135	<	function GetFieldName: string; override;
136	<	function GetOwnerName: string;  override;
137	<	function GetRelationName: string;  override;
134	>	function GetAliasName: AnsiString;  override;
135	>	function GetFieldName: AnsiString; override;
136	>	function GetOwnerName: AnsiString;  override;
137	>	function GetRelationName: AnsiString;  override;
138		function GetScale: integer; override;
139		function GetCharSetID: cardinal; override;
140		function GetCodePage: TSystemCodePage; override;
141		function GetIsNull: Boolean;   override;
142		function GetIsNullable: boolean; override;
143	<	function GetSQLData: PChar;  override;
143	>	function GetSQLData: PByte;  override;
144		function GetDataLength: cardinal; override;
145		procedure SetIsNull(Value: Boolean); override;
146		procedure SetIsNullable(Value: Boolean);  override;
147	<	procedure SetSQLData(AValue: PChar; len: cardinal); override;
147	>	procedure SetSQLData(AValue: PByte; len: cardinal); override;
148		procedure SetScale(aValue: integer); override;
149		procedure SetDataLength(len: cardinal); override;
150		procedure SetSQLType(aValue: cardinal); override;
#	Line 211 | Line 214 | type
214		procedure Bind;
215		function GetTransaction: TFB25Transaction; override;
216		procedure GetData(index: integer; var aIsNull: boolean; var len: short;
217	<	var data: PChar); override;
217	>	var data: PByte); override;
218		function IsInputDataArea: boolean; override;
219		end;
220
#	Line 226 | Line 229 | type
229		destructor Destroy; override;
230		{IResultSet}
231		function FetchNext: boolean;
232	<	function GetCursorName: string;
232	>	function GetCursorName: AnsiString;
233		function GetTransaction: ITransaction; override;
234		function IsEof: boolean;
235		procedure Close;
#	Line 240 | Line 243 | type
243		FHandle: TISC_STMT_HANDLE;
244		FSQLParams: TIBXINPUTSQLDA;
245		FSQLRecord: TIBXOUTPUTSQLDA;
246	<	FCursor: String;               { Cursor name...}
246	>	FCursor: AnsiString;               { Cursor name...}
247		FCursorSeqNo: integer;
248	+	procedure GetPerfCounters(var counters: TPerfStatistics);
249		protected
250		procedure CheckHandle; override;
251		procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); override;
#	Line 252 | Line 256 | type
256		procedure InternalClose(Force: boolean); override;
257		public
258		constructor Create(Attachment: TFB25Attachment; Transaction: ITransaction;
259	<	sql: string; aSQLDialect: integer);
259	>	sql: AnsiString; aSQLDialect: integer);
260		constructor CreateWithParameterNames(Attachment: TFB25Attachment;
261	<	Transaction: ITransaction; sql: string; aSQLDialect: integer; GenerateParamNames: boolean);
261	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean);
262		destructor Destroy; override;
263		function FetchNext: boolean;
264
#	Line 262 | Line 266 | type
266		{IStatement}
267		function GetSQLParams: ISQLParams; override;
268		function GetMetaData: IMetaData; override;
269	<	function GetPlan: String;
269	>	function GetPlan: AnsiString;
270		function IsPrepared: boolean;
271		function CreateBlob(column: TColumnMetaData): IBlob; override;
272		function CreateArray(column: TColumnMetaData): IArray; override;
#	Line 273 | Line 277 | end;
277
278		implementation
279
280	<	uses IBUtils, FBMessages, FB25Blob, variants, IBErrorCodes, FBArray, FB25Array;
280	>	uses IBUtils, FBMessages, FBBlob, FB25Blob, variants, IBErrorCodes, FBArray, FB25Array
281	>	{$IFDEF UNIX}, BaseUnix {$ENDIF};
282
283
284		{ TIBXSQLVAR }
#	Line 291 | Line 296 | begin
296		result := 0;
297		end;
298
299	<	function TIBXSQLVAR.GetAliasName: string;
299	>	function TIBXSQLVAR.GetAliasName: AnsiString;
300		begin
301		result := strpas(FXSQLVAR^.aliasname);
302		end;
303
304	<	function TIBXSQLVAR.GetFieldName: string;
304	>	function TIBXSQLVAR.GetFieldName: AnsiString;
305		begin
306		result := strpas(FXSQLVAR^.sqlname);
307		end;
308
309	<	function TIBXSQLVAR.GetOwnerName: string;
309	>	function TIBXSQLVAR.GetOwnerName: AnsiString;
310		begin
311		result := strpas(FXSQLVAR^.ownname);
312		end;
313
314	<	function TIBXSQLVAR.GetRelationName: string;
314	>	function TIBXSQLVAR.GetRelationName: AnsiString;
315		begin
316		result := strpas(FXSQLVAR^.relname);
317		end;
#	Line 330 | Line 335 | begin
335		SQL_BLOB:
336		if (SQLSubType = 1)  then
337		{see http://firebirdsql.org/rlsnotesh/rlsnotes210.html}
338	<	result := FXSQLVAR^.sqlscale;
338	>	result := FXSQLVAR^.sqlscale and $FF;
339
340		SQL_ARRAY:
341		if (GetRelationName <> '') and (GetFieldName <> '') then
#	Line 341 | Line 346 | end;
346		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
347		begin
348		result := CP_NONE;
349	<	with FirebirdClientAPI do
349	>	with Statement.GetAttachment do
350		CharSetID2CodePage(GetCharSetID,result);
351		end;
352
#	Line 355 | Line 360 | begin
360		result := (FXSQLVAR^.sqltype and 1 = 1);
361		end;
362
363	<	function TIBXSQLVAR.GetSQLData: PChar;
363	>	function TIBXSQLVAR.GetSQLData: PByte;
364		begin
365		Result := FXSQLVAR^.sqldata;
366		end;
#	Line 386 | Line 391 | begin
391		FBlobMetaData := TFB25BlobMetaData.Create(FStatement.GetAttachment as TFB25Attachment,
392		FStatement.GetTransaction as TFB25Transaction,
393		GetRelationName,GetFieldName,GetSubType);
394	+	(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
395		Result := FBlobMetaData;
396		end;
397
#	Line 468 | Line 474 | procedure TIBXSQLVAR.SetIsNull(Value: Bo
474		begin
475		if Value then
476		begin
477	<	if not IsNullable then
478	<	IsNullable := True;
473	<
474	<	FNullIndicator := -1;
477	>	IsNullable := true;
478	>	FNullIndicator := -1;
479		Changed;
480		end
481		else
#	Line 500 | Line 504 | begin
504		end;
505		end;
506
507	<	procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
507	>	procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
508		begin
509		if FOwnsSQLData then
510		FreeMem(FXSQLVAR^.sqldata);
#	Line 589 | Line 593 | begin
593		FResults.Column[i].RowChange;
594		end;
595
596	<	function TResultSet.GetCursorName: string;
596	>	function TResultSet.GetCursorName: AnsiString;
597		begin
598		Result := FResults.FStatement.FCursor;
599		end;
#	Line 674 | Line 678 | begin
678		end;
679
680		procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull:boolean; var len: short;
681	<	var data: PChar);
681	>	var data: PByte);
682		begin
683		with TIBXSQLVAR(Column[index]), FXSQLVAR^ do
684		begin
#	Line 795 | Line 799 | begin
799		if i >= FSize then
800		FColumnList[i] := TIBXSQLVAR.Create(self,i);
801		TIBXSQLVAR(Column[i]).FXSQLVAR := p;
802	<	p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
802	>	p := Pointer(PAnsiChar(p) + sizeof(FXSQLDA^.sqlvar));
803		end;
804		FSize := inherited Count;
805		end;
#	Line 836 | Line 840 | end;
840
841		{ TFB25Statement }
842
843	+	procedure TFB25Statement.GetPerfCounters(var counters: TPerfStatistics);
844	+	var DBInfo: IDBInformation;
845	+	i: integer;
846	+	{$IFDEF UNIX}
847	+	times: tms;
848	+	{$ENDIF}
849	+	begin
850	+	{$IFDEF UNIX}
851	+	FpTimes(times);
852	+	counters[psUserTime] := times.tms_utime;
853	+	{$ELSE}
854	+	counters[psUserTime] := 0;
855	+	{$ENDIF}
856	+	counters[psRealTime] := TimeStampToMSecs(DateTimeToTimeStamp(Now));
857	+
858	+	DBInfo := GetAttachment.GetDBInformation([isc_info_reads,isc_info_writes,
859	+	isc_info_fetches, isc_info_num_buffers, isc_info_current_memory,
860	+	isc_info_max_memory]);
861	+	if DBInfo <> nil then
862	+	begin
863	+	for i := 0 to DBInfo.Count - 1 do
864	+	with DBInfo[i] do
865	+	case getItemType of
866	+	isc_info_reads:
867	+	counters[psReads] := AsInteger;
868	+	isc_info_writes:
869	+	counters[psWrites] := AsInteger;
870	+	isc_info_fetches:
871	+	counters[psFetches] := AsInteger;
872	+	isc_info_num_buffers:
873	+	counters[psBuffers] := AsInteger;
874	+	isc_info_current_memory:
875	+	counters[psCurrentMemory] := AsInteger;
876	+	isc_info_max_memory:
877	+	counters[psMaxMemory] := AsInteger;
878	+	end;
879	+	end;
880	+	end;
881	+
882		procedure TFB25Statement.CheckHandle;
883		begin
884		if FHandle = nil then
#	Line 872 | Line 915 | begin
915		if FProcessedSQL = '' then
916		FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
917		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
918	<	PChar(FProcessedSQL), FSQLDialect, nil), True);
918	>	PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
919		end
920		else
921		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
922	<	PChar(FSQL), FSQLDialect, nil), True);
922	>	PAnsiChar(FSQL), FSQLDialect, nil), True);
923		end;
924		{ After preparing the statement, query the stmt type and possibly
925		create a FSQLRecord "holder" }
#	Line 887 | Line 930 | begin
930		else
931		FSQLStatementType := SQLUnknown;
932
890	–	{ Done getting the type }
933		case FSQLStatementType of
934		SQLGetSegment,
935		SQLPutSegment,
#	Line 958 | Line 1000 | begin
1000		try
1001		TRHandle := (aTransaction as TFB25Transaction).Handle;
1002		with Firebird25ClientAPI do
961	–	case FSQLStatementType of
962	–	SQLSelect:
963	–	IBError(ibxeIsAExecuteProcedure,[]);
964	–
965	–	SQLExecProcedure:
1003		begin
1004	<	Call(isc_dsql_execute2(StatusVector,
1005	<	@(TRHandle),
1006	<	@FHandle,
1007	<	SQLDialect,
1008	<	FSQLParams.AsXSQLDA,
1009	<	FSQLRecord.AsXSQLDA), True);
1010	<	Result := TResults.Create(FSQLRecord);
1011	<	FSingleResults := true;
1012	<	end
1013	<	else
1014	<	Call(isc_dsql_execute(StatusVector,
1015	<	@(TRHandle),
1016	<	@FHandle,
1017	<	SQLDialect,
1018	<	FSQLParams.AsXSQLDA), True);
1004	>	if FCollectStatistics then
1005	>	GetPerfCounters(FBeforeStats);
1006	>
1007	>	case FSQLStatementType of
1008	>	SQLSelect:
1009	>	IBError(ibxeIsAExecuteProcedure,[]);
1010	>
1011	>	SQLExecProcedure:
1012	>	begin
1013	>	Call(isc_dsql_execute2(StatusVector,
1014	>	@(TRHandle),
1015	>	@FHandle,
1016	>	SQLDialect,
1017	>	FSQLParams.AsXSQLDA,
1018	>	FSQLRecord.AsXSQLDA), True);
1019	>	Result := TResults.Create(FSQLRecord);
1020	>	FSingleResults := true;
1021	>	end
1022	>	else
1023	>	Call(isc_dsql_execute(StatusVector,
1024	>	@(TRHandle),
1025	>	@FHandle,
1026	>	SQLDialect,
1027	>	FSQLParams.AsXSQLDA), True);
1028
1029	+	end;
1030	+	if FCollectStatistics then
1031	+	begin
1032	+	GetPerfCounters(FAfterStats);
1033	+	FStatisticsAvailable := true;
1034	+	end;
1035		end;
1036		finally
1037		if aTransaction <> FTransactionIntf then
#	Line 1008 | Line 1060 | begin
1060
1061		with Firebird25ClientAPI do
1062		begin
1063	+	if FCollectStatistics then
1064	+	GetPerfCounters(FBeforeStats);
1065	+
1066		TRHandle := (aTransaction as TFB25Transaction).Handle;
1067		Call(isc_dsql_execute2(StatusVector,
1068		@(TRHandle),
#	Line 1020 | Line 1075 | begin
1075		CreateGuid(GUID);
1076		FCursor := GUIDToString(GUID);
1077		Call(
1078	<	isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
1078	>	isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1079		True);
1080		end;
1081	+
1082	+	if FCollectStatistics then
1083	+	begin
1084	+	GetPerfCounters(FAfterStats);
1085	+	FStatisticsAvailable := true;
1086	+	end;
1087		end;
1088		Inc(FCursorSeqNo);
1089		FSingleResults := false;
#	Line 1075 | Line 1136 | begin
1136		IBDatabaseError;
1137		end;
1138		finally
1139	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1139	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB25Transaction)) then
1140		RemoveMonitor(FSQLRecord.FTransaction);
1141		FOpen := False;
1142		FExecTransactionIntf := nil;
#	Line 1085 | Line 1146 | begin
1146		end;
1147
1148		constructor TFB25Statement.Create(Attachment: TFB25Attachment;
1149	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1149	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1150		begin
1151		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1152		FDBHandle := Attachment.Handle;
#	Line 1095 | Line 1156 | begin
1156		end;
1157
1158		constructor TFB25Statement.CreateWithParameterNames(Attachment: TFB25Attachment;
1159	<	Transaction: ITransaction; sql: string; aSQLDialect: integer;
1159	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1160		GenerateParamNames: boolean);
1161		begin
1162		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
#	Line 1170 | Line 1231 | begin
1231		Result := TMetaData(GetInterface(1));
1232		end;
1233
1234	<	function TFB25Statement.GetPlan: String;
1234	>	function TFB25Statement.GetPlan: AnsiString;
1235		var
1236		RB: ISQLInfoResults;
1237		begin

Diff Legend

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