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 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 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 118 | Line 121 | type
121		TIBXSQLVAR = class(TSQLVarData)
122		private
123		FStatement: TFB25Statement;
124	+	FFirebird25ClientAPI: TFB25ClientAPI;
125		FBlob: IBlob;             {Cache references}
126		FArray: IArray;
127		FNullIndicator: short;
#	Line 128 | Line 132 | type
132		protected
133		function GetSQLType: cardinal; override;
134		function GetSubtype: integer; override;
135	<	function GetAliasName: string;  override;
136	<	function GetFieldName: string; override;
137	<	function GetOwnerName: string;  override;
138	<	function GetRelationName: string;  override;
135	>	function GetAliasName: AnsiString;  override;
136	>	function GetFieldName: AnsiString; override;
137	>	function GetOwnerName: AnsiString;  override;
138	>	function GetRelationName: AnsiString;  override;
139		function GetScale: integer; override;
140		function GetCharSetID: cardinal; override;
141		function GetCodePage: TSystemCodePage; override;
142		function GetIsNull: Boolean;   override;
143		function GetIsNullable: boolean; override;
144	<	function GetSQLData: PChar;  override;
144	>	function GetSQLData: PByte;  override;
145		function GetDataLength: cardinal; override;
146		procedure SetIsNull(Value: Boolean); override;
147		procedure SetIsNullable(Value: Boolean);  override;
148	<	procedure SetSQLData(AValue: PChar; len: cardinal); override;
148	>	procedure SetSQLData(AValue: PByte; len: cardinal); override;
149		procedure SetScale(aValue: integer); override;
150		procedure SetDataLength(len: cardinal); override;
151		procedure SetSQLType(aValue: cardinal); override;
#	Line 174 | Line 178 | type
178		function GetXSQLDA: PXSQLDA;
179		protected
180		FStatement: TFB25Statement;
181	+	FFirebird25ClientAPI: TFB25ClientAPI;
182		function GetTransactionSeqNo: integer; override;
183		procedure FreeXSQLDA;
184		function GetStatement: IStatement; override;
#	Line 211 | Line 216 | type
216		procedure Bind;
217		function GetTransaction: TFB25Transaction; override;
218		procedure GetData(index: integer; var aIsNull: boolean; var len: short;
219	<	var data: PChar); override;
219	>	var data: PByte); override;
220		function IsInputDataArea: boolean; override;
221		end;
222
#	Line 226 | Line 231 | type
231		destructor Destroy; override;
232		{IResultSet}
233		function FetchNext: boolean;
234	<	function GetCursorName: string;
234	>	function GetCursorName: AnsiString;
235		function GetTransaction: ITransaction; override;
236		function IsEof: boolean;
237		procedure Close;
#	Line 238 | Line 243 | type
243		private
244		FDBHandle: TISC_DB_HANDLE;
245		FHandle: TISC_STMT_HANDLE;
246	+	FFirebird25ClientAPI: TFB25ClientAPI;
247		FSQLParams: TIBXINPUTSQLDA;
248		FSQLRecord: TIBXOUTPUTSQLDA;
249	<	FCursor: String;               { Cursor name...}
249	>	FCursor: AnsiString;               { Cursor name...}
250		FCursorSeqNo: integer;
251		procedure GetPerfCounters(var counters: TPerfStatistics);
252		protected
#	Line 249 | Line 255 | type
255		procedure InternalPrepare; override;
256		function InternalExecute(aTransaction: ITransaction): IResults; override;
257		function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
258	+	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
259		procedure FreeHandle; override;
260		procedure InternalClose(Force: boolean); override;
261		public
262		constructor Create(Attachment: TFB25Attachment; Transaction: ITransaction;
263	<	sql: string; aSQLDialect: integer);
263	>	sql: AnsiString; aSQLDialect: integer);
264		constructor CreateWithParameterNames(Attachment: TFB25Attachment;
265	<	Transaction: ITransaction; sql: string; aSQLDialect: integer; GenerateParamNames: boolean);
265	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean);
266		destructor Destroy; override;
267		function FetchNext: boolean;
268
#	Line 263 | Line 270 | type
270		{IStatement}
271		function GetSQLParams: ISQLParams; override;
272		function GetMetaData: IMetaData; override;
273	<	function GetPlan: String;
273	>	function GetPlan: AnsiString;
274		function IsPrepared: boolean;
275		function CreateBlob(column: TColumnMetaData): IBlob; override;
276		function CreateArray(column: TColumnMetaData): IArray; override;
#	Line 293 | Line 300 | begin
300		result := 0;
301		end;
302
303	<	function TIBXSQLVAR.GetAliasName: string;
303	>	function TIBXSQLVAR.GetAliasName: AnsiString;
304		begin
305		result := strpas(FXSQLVAR^.aliasname);
306		end;
307
308	<	function TIBXSQLVAR.GetFieldName: string;
308	>	function TIBXSQLVAR.GetFieldName: AnsiString;
309		begin
310		result := strpas(FXSQLVAR^.sqlname);
311		end;
312
313	<	function TIBXSQLVAR.GetOwnerName: string;
313	>	function TIBXSQLVAR.GetOwnerName: AnsiString;
314		begin
315		result := strpas(FXSQLVAR^.ownname);
316		end;
317
318	<	function TIBXSQLVAR.GetRelationName: string;
318	>	function TIBXSQLVAR.GetRelationName: AnsiString;
319		begin
320		result := strpas(FXSQLVAR^.relname);
321		end;
#	Line 332 | Line 339 | begin
339		SQL_BLOB:
340		if (SQLSubType = 1)  then
341		{see http://firebirdsql.org/rlsnotesh/rlsnotes210.html}
342	<	result := FXSQLVAR^.sqlscale;
342	>	result := FXSQLVAR^.sqlscale and $FF;
343
344		SQL_ARRAY:
345		if (GetRelationName <> '') and (GetFieldName <> '') then
#	Line 343 | Line 350 | end;
350		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
351		begin
352		result := CP_NONE;
353	<	with FirebirdClientAPI do
353	>	with Statement.GetAttachment do
354		CharSetID2CodePage(GetCharSetID,result);
355		end;
356
#	Line 357 | Line 364 | begin
364		result := (FXSQLVAR^.sqltype and 1 = 1);
365		end;
366
367	<	function TIBXSQLVAR.GetSQLData: PChar;
367	>	function TIBXSQLVAR.GetSQLData: PByte;
368		begin
369		Result := FXSQLVAR^.sqldata;
370		end;
#	Line 438 | Line 445 | procedure TIBXSQLVAR.Initialize;
445		begin
446		inherited Initialize;
447		FOwnsSQLData := true;
448	<	with FirebirdClientAPI, FXSQLVar^ do
448	>	with FFirebird25ClientAPI, FXSQLVar^ do
449		begin
450		case sqltype and (not 1) of
451		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
#	Line 499 | Line 506 | begin
506		FXSQLVAR^.sqlind := nil;
507		end;
508		end;
509	+	Changed;
510		end;
511
512	<	procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
512	>	procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
513		begin
514		if FOwnsSQLData then
515		FreeMem(FXSQLVAR^.sqldata);
516		FXSQLVAR^.sqldata := AValue;
517		FXSQLVAR^.sqllen := len;
518		FOwnsSQLData := false;
519	+	Changed;
520		end;
521
522		procedure TIBXSQLVAR.SetScale(aValue: integer);
523		begin
524		FXSQLVAR^.sqlscale := aValue;
525	+	Changed;
526		end;
527
528		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 520 | Line 530 | begin
530		if not FOwnsSQLData then
531		FXSQLVAR^.sqldata := nil;
532		FXSQLVAR^.sqllen := len;
533	<	with FirebirdClientAPI do
533	>	with FFirebird25ClientAPI do
534		IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
535		FOwnsSQLData := true;
536	+	Changed;
537		end;
538
539		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
540		begin
541		FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
542	+	Changed;
543		end;
544
545		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
546		begin
547		if aValue <> GetCharSetID then
548	<	case SQLType of
549	<	SQL_VARYING, SQL_TEXT:
550	<	FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
551	<
552	<	SQL_BLOB,
553	<	SQL_ARRAY:
554	<	IBError(ibxeInvalidDataConversion,[nil]);
548	>	begin
549	>	case SQLType of
550	>	SQL_VARYING, SQL_TEXT:
551	>	FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
552	>
553	>	SQL_BLOB,
554	>	SQL_ARRAY:
555	>	IBError(ibxeInvalidDataConversion,[nil]);
556	>	end;
557	>	Changed;
558		end;
559		end;
560
#	Line 547 | Line 562 | constructor TIBXSQLVAR.Create(aParent: T
562		begin
563		inherited Create(aParent,aIndex);
564		FStatement := aParent.Statement;
565	+	FFirebird25ClientAPI := aParent.FFirebird25ClientAPI;
566		end;
567
568		procedure TIBXSQLVAR.FreeSQLData;
#	Line 590 | Line 606 | begin
606		FResults.Column[i].RowChange;
607		end;
608
609	<	function TResultSet.GetCursorName: string;
609	>	function TResultSet.GetCursorName: AnsiString;
610		begin
611		Result := FResults.FStatement.FCursor;
612		end;
#	Line 617 | Line 633 | procedure TIBXINPUTSQLDA.Bind;
633		begin
634		if Count = 0 then
635		Count := 1;
636	<	with Firebird25ClientAPI do
636	>	with FFirebird25ClientAPI do
637		begin
638		if (FXSQLDA <> nil) then
639		if isc_dsql_describe_bind(StatusVector, @(FStatement.Handle), FStatement.SQLDialect,
#	Line 649 | Line 665 | procedure TIBXOUTPUTSQLDA.Bind;
665		begin
666		{ Allocate an initial output descriptor (with one column) }
667		Count := 1;
668	<	with Firebird25ClientAPI do
668	>	with FFirebird25ClientAPI do
669		begin
670		{ Using isc_dsql_describe, get the right size for the columns... }
671		if isc_dsql_describe(StatusVector, @(FStatement.Handle), FStatement.SQLDialect, FXSQLDA) > 0 then
#	Line 675 | Line 691 | begin
691		end;
692
693		procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull:boolean; var len: short;
694	<	var data: PChar);
694	>	var data: PByte);
695		begin
696		with TIBXSQLVAR(Column[index]), FXSQLVAR^ do
697		begin
#	Line 684 | Line 700 | begin
700		len := sqllen;
701		if not IsNull and ((sqltype and (not 1)) = SQL_VARYING) then
702		begin
703	<	with FirebirdClientAPI do
703	>	with FFirebird25ClientAPI do
704		len := DecodeInteger(data,2);
705		Inc(data,2);
706		end;
#	Line 701 | Line 717 | constructor TIBXSQLDA.Create(aStatement:
717		begin
718		inherited Create;
719		FStatement := aStatement;
720	+	FFirebird25ClientAPI := aStatement.FFirebird25ClientAPI;
721		FSize := 0;
722		//  writeln('Creating ',ClassName);
723		end;
#	Line 787 | Line 804 | begin
804		OldSize := 0;
805		if Count > FSize then
806		begin
807	<	Firebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
807	>	FFirebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
808		SetLength(FColumnList, FCount);
809		FXSQLDA^.version := SQLDA_VERSION1;
810		p := @FXSQLDA^.sqlvar[0];
#	Line 796 | Line 813 | begin
813		if i >= FSize then
814		FColumnList[i] := TIBXSQLVAR.Create(self,i);
815		TIBXSQLVAR(Column[i]).FXSQLVAR := p;
816	<	p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
816	>	p := Pointer(PAnsiChar(p) + sizeof(FXSQLDA^.sqlvar));
817		end;
818		FSize := inherited Count;
819		end;
#	Line 850 | Line 867 | begin
867		{$ELSE}
868		counters[psUserTime] := 0;
869		{$ENDIF}
870	<	counters[psRealTime] := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)));
870	>	counters[psRealTime] := TimeStampToMSecs(DateTimeToTimeStamp(Now));
871
872		DBInfo := GetAttachment.GetDBInformation([isc_info_reads,isc_info_writes,
873		isc_info_fetches, isc_info_num_buffers, isc_info_current_memory,
#	Line 885 | Line 902 | end;
902		procedure TFB25Statement.GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults
903		);
904		begin
905	<	with Firebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
905	>	with FFirebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
906		if isc_dsql_sql_info(StatusVector, @(FHandle), 1, @info_request,
907		GetBufSize, Buffer) > 0 then
908		IBDatabaseError;
#	Line 902 | Line 919 | begin
919		IBError(ibxeEmptyQuery, [nil]);
920		try
921		CheckTransaction(FTransactionIntf);
922	<	with Firebird25ClientAPI do
922	>	with FFirebird25ClientAPI do
923		begin
924		Call(isc_dsql_alloc_statement2(StatusVector, @(FDBHandle),
925		@FHandle), True);
#	Line 910 | Line 927 | begin
927		if FHasParamNames then
928		begin
929		if FProcessedSQL = '' then
930	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
930	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
931		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
932	<	PChar(FProcessedSQL), FSQLDialect, nil), True);
932	>	PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
933		end
934		else
935		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
936	<	PChar(FSQL), FSQLDialect, nil), True);
936	>	PAnsiChar(FSQL), FSQLDialect, nil), True);
937		end;
938		{ After preparing the statement, query the stmt type and possibly
939		create a FSQLRecord "holder" }
#	Line 996 | Line 1013 | begin
1013
1014		try
1015		TRHandle := (aTransaction as TFB25Transaction).Handle;
1016	<	with Firebird25ClientAPI do
1016	>	with FFirebird25ClientAPI do
1017		begin
1018		if FCollectStatistics then
1019		GetPerfCounters(FBeforeStats);
#	Line 1035 | Line 1052 | begin
1052		RemoveMonitor(aTransaction as TFB25Transaction);
1053		end;
1054		FExecTransactionIntf := aTransaction;
1055	+	FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1056	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1057		Inc(FChangeSeqNo);
1058		end;
1059
#	Line 1055 | Line 1074 | begin
1074		if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1075		IBError(ibxeInterfaceOutofDate,[nil]);
1076
1077	<	with Firebird25ClientAPI do
1077	>	with FFirebird25ClientAPI do
1078		begin
1079		if FCollectStatistics then
1080		GetPerfCounters(FBeforeStats);
#	Line 1072 | Line 1091 | begin
1091		CreateGuid(GUID);
1092		FCursor := GUIDToString(GUID);
1093		Call(
1094	<	isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
1094	>	isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1095		True);
1096		end;
1097
#	Line 1094 | Line 1113 | begin
1113		Inc(FChangeSeqNo);
1114		end;
1115
1116	+	procedure TFB25Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1117	+	var processedSQL: AnsiString);
1118	+	begin
1119	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames, processedSQL);
1120	+	end;
1121	+
1122		procedure TFB25Statement.FreeHandle;
1123		var
1124		isc_res: ISC_STATUS;
#	Line 1102 | Line 1127 | begin
1127		ReleaseInterfaces;
1128		try
1129		if FHandle <> nil then
1130	<	with Firebird25ClientAPI do
1130	>	with FFirebird25ClientAPI do
1131		begin
1132		isc_res :=
1133		Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
#	Line 1122 | Line 1147 | var
1147		begin
1148		if (FHandle <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1149		try
1150	<	with Firebird25ClientAPI do
1150	>	with FFirebird25ClientAPI do
1151		begin
1152		isc_res := Call(
1153		isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
#	Line 1133 | Line 1158 | begin
1158		IBDatabaseError;
1159		end;
1160		finally
1161	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1161	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB25Transaction)) then
1162		RemoveMonitor(FSQLRecord.FTransaction);
1163		FOpen := False;
1164		FExecTransactionIntf := nil;
#	Line 1143 | Line 1168 | begin
1168		end;
1169
1170		constructor TFB25Statement.Create(Attachment: TFB25Attachment;
1171	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1171	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1172		begin
1173		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1174		FDBHandle := Attachment.Handle;
1175	+	FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1176	+	OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1177		FSQLParams := TIBXINPUTSQLDA.Create(self);
1178		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1179		InternalPrepare;
1180		end;
1181
1182		constructor TFB25Statement.CreateWithParameterNames(Attachment: TFB25Attachment;
1183	<	Transaction: ITransaction; sql: string; aSQLDialect: integer;
1183	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1184		GenerateParamNames: boolean);
1185		begin
1186		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1187		FDBHandle := Attachment.Handle;
1188	+	FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1189	+	OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1190		FSQLParams := TIBXINPUTSQLDA.Create(self);
1191		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1192		InternalPrepare;
#	Line 1180 | Line 1209 | begin
1209		if FEOF then
1210		IBError(ibxeEOF,[nil]);
1211
1212	<	with Firebird25ClientAPI do
1212	>	with FFirebird25ClientAPI do
1213		begin
1214		{ Go to the next record... }
1215		fetch_res :=
#	Line 1206 | Line 1235 | begin
1235		FBOF := false;
1236		result := true;
1237		end;
1238	+	if FCollectStatistics then
1239	+	begin
1240	+	GetPerfCounters(FAfterStats);
1241	+	FStatisticsAvailable := true;
1242	+	end;
1243		end;
1244		FSQLRecord.RowChange;
1245		if FEOF then
#	Line 1228 | Line 1262 | begin
1262		Result := TMetaData(GetInterface(1));
1263		end;
1264
1265	<	function TFB25Statement.GetPlan: String;
1265	>	function TFB25Statement.GetPlan: AnsiString;
1266		var
1267		RB: ISQLInfoResults;
1268		begin
#	Line 1238 | Line 1272 | begin
1272		result := ''
1273		else
1274		begin
1275	<	RB := TSQLInfoResultsBuffer.Create(4*4096);
1275	>	RB := TSQLInfoResultsBuffer.Create(FFirebird25ClientAPI,4*4096);
1276		GetDsqlInfo(isc_info_sql_get_plan,RB);
1277		if RB.Count > 0 then
1278		Result := RB[0].GetAsString;

Diff Legend

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