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 270 by tony, Fri Jan 18 11:10:37 2019 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	>	CaseSensitiveParams: boolean=false);
267		destructor Destroy; override;
268		function FetchNext: boolean;
269
#	Line 263 | Line 271 | type
271		{IStatement}
272		function GetSQLParams: ISQLParams; override;
273		function GetMetaData: IMetaData; override;
274	<	function GetPlan: String;
274	>	function GetPlan: AnsiString;
275		function IsPrepared: boolean;
276		function CreateBlob(column: TColumnMetaData): IBlob; override;
277		function CreateArray(column: TColumnMetaData): IArray; override;
#	Line 293 | Line 301 | begin
301		result := 0;
302		end;
303
304	<	function TIBXSQLVAR.GetAliasName: string;
304	>	function TIBXSQLVAR.GetAliasName: AnsiString;
305		begin
306		result := strpas(FXSQLVAR^.aliasname);
307		end;
308
309	<	function TIBXSQLVAR.GetFieldName: string;
309	>	function TIBXSQLVAR.GetFieldName: AnsiString;
310		begin
311		result := strpas(FXSQLVAR^.sqlname);
312		end;
313
314	<	function TIBXSQLVAR.GetOwnerName: string;
314	>	function TIBXSQLVAR.GetOwnerName: AnsiString;
315		begin
316		result := strpas(FXSQLVAR^.ownname);
317		end;
318
319	<	function TIBXSQLVAR.GetRelationName: string;
319	>	function TIBXSQLVAR.GetRelationName: AnsiString;
320		begin
321		result := strpas(FXSQLVAR^.relname);
322		end;
#	Line 332 | Line 340 | begin
340		SQL_BLOB:
341		if (SQLSubType = 1)  then
342		{see http://firebirdsql.org/rlsnotesh/rlsnotes210.html}
343	<	result := FXSQLVAR^.sqlscale;
343	>	result := FXSQLVAR^.sqlscale and $FF;
344
345		SQL_ARRAY:
346		if (GetRelationName <> '') and (GetFieldName <> '') then
#	Line 343 | Line 351 | end;
351		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
352		begin
353		result := CP_NONE;
354	<	with FirebirdClientAPI do
354	>	with Statement.GetAttachment do
355		CharSetID2CodePage(GetCharSetID,result);
356		end;
357
#	Line 357 | Line 365 | begin
365		result := (FXSQLVAR^.sqltype and 1 = 1);
366		end;
367
368	<	function TIBXSQLVAR.GetSQLData: PChar;
368	>	function TIBXSQLVAR.GetSQLData: PByte;
369		begin
370		Result := FXSQLVAR^.sqldata;
371		end;
#	Line 438 | Line 446 | procedure TIBXSQLVAR.Initialize;
446		begin
447		inherited Initialize;
448		FOwnsSQLData := true;
449	<	with FirebirdClientAPI, FXSQLVar^ do
449	>	with FFirebird25ClientAPI, FXSQLVar^ do
450		begin
451		case sqltype and (not 1) of
452		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
#	Line 499 | Line 507 | begin
507		FXSQLVAR^.sqlind := nil;
508		end;
509		end;
510	+	Changed;
511		end;
512
513	<	procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
513	>	procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
514		begin
515		if FOwnsSQLData then
516		FreeMem(FXSQLVAR^.sqldata);
517		FXSQLVAR^.sqldata := AValue;
518		FXSQLVAR^.sqllen := len;
519		FOwnsSQLData := false;
520	+	Changed;
521		end;
522
523		procedure TIBXSQLVAR.SetScale(aValue: integer);
524		begin
525		FXSQLVAR^.sqlscale := aValue;
526	+	Changed;
527		end;
528
529		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 520 | Line 531 | begin
531		if not FOwnsSQLData then
532		FXSQLVAR^.sqldata := nil;
533		FXSQLVAR^.sqllen := len;
534	<	with FirebirdClientAPI do
534	>	with FFirebird25ClientAPI do
535		IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
536		FOwnsSQLData := true;
537	+	Changed;
538		end;
539
540		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
541		begin
542		FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
543	+	Changed;
544		end;
545
546		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
547		begin
548		if aValue <> GetCharSetID then
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]);
549	>	begin
550	>	case SQLType of
551	>	SQL_VARYING, SQL_TEXT:
552	>	FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
553	>
554	>	SQL_BLOB,
555	>	SQL_ARRAY:
556	>	IBError(ibxeInvalidDataConversion,[nil]);
557	>	end;
558	>	Changed;
559		end;
560		end;
561
#	Line 547 | Line 563 | constructor TIBXSQLVAR.Create(aParent: T
563		begin
564		inherited Create(aParent,aIndex);
565		FStatement := aParent.Statement;
566	+	FFirebird25ClientAPI := aParent.FFirebird25ClientAPI;
567		end;
568
569		procedure TIBXSQLVAR.FreeSQLData;
#	Line 590 | Line 607 | begin
607		FResults.Column[i].RowChange;
608		end;
609
610	<	function TResultSet.GetCursorName: string;
610	>	function TResultSet.GetCursorName: AnsiString;
611		begin
612		Result := FResults.FStatement.FCursor;
613		end;
#	Line 617 | Line 634 | procedure TIBXINPUTSQLDA.Bind;
634		begin
635		if Count = 0 then
636		Count := 1;
637	<	with Firebird25ClientAPI do
637	>	with FFirebird25ClientAPI do
638		begin
639		if (FXSQLDA <> nil) then
640		if isc_dsql_describe_bind(StatusVector, @(FStatement.Handle), FStatement.SQLDialect,
#	Line 649 | Line 666 | procedure TIBXOUTPUTSQLDA.Bind;
666		begin
667		{ Allocate an initial output descriptor (with one column) }
668		Count := 1;
669	<	with Firebird25ClientAPI do
669	>	with FFirebird25ClientAPI do
670		begin
671		{ Using isc_dsql_describe, get the right size for the columns... }
672		if isc_dsql_describe(StatusVector, @(FStatement.Handle), FStatement.SQLDialect, FXSQLDA) > 0 then
#	Line 675 | Line 692 | begin
692		end;
693
694		procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull:boolean; var len: short;
695	<	var data: PChar);
695	>	var data: PByte);
696		begin
697		with TIBXSQLVAR(Column[index]), FXSQLVAR^ do
698		begin
#	Line 684 | Line 701 | begin
701		len := sqllen;
702		if not IsNull and ((sqltype and (not 1)) = SQL_VARYING) then
703		begin
704	<	with FirebirdClientAPI do
704	>	with FFirebird25ClientAPI do
705		len := DecodeInteger(data,2);
706		Inc(data,2);
707		end;
#	Line 701 | Line 718 | constructor TIBXSQLDA.Create(aStatement:
718		begin
719		inherited Create;
720		FStatement := aStatement;
721	+	FFirebird25ClientAPI := aStatement.FFirebird25ClientAPI;
722		FSize := 0;
723		//  writeln('Creating ',ClassName);
724		end;
#	Line 787 | Line 805 | begin
805		OldSize := 0;
806		if Count > FSize then
807		begin
808	<	Firebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
808	>	FFirebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
809		SetLength(FColumnList, FCount);
810		FXSQLDA^.version := SQLDA_VERSION1;
811		p := @FXSQLDA^.sqlvar[0];
#	Line 796 | Line 814 | begin
814		if i >= FSize then
815		FColumnList[i] := TIBXSQLVAR.Create(self,i);
816		TIBXSQLVAR(Column[i]).FXSQLVAR := p;
817	<	p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
817	>	p := Pointer(PAnsiChar(p) + sizeof(FXSQLDA^.sqlvar));
818		end;
819		FSize := inherited Count;
820		end;
#	Line 850 | Line 868 | begin
868		{$ELSE}
869		counters[psUserTime] := 0;
870		{$ENDIF}
871	<	counters[psRealTime] := Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)));
871	>	counters[psRealTime] := TimeStampToMSecs(DateTimeToTimeStamp(Now));
872
873		DBInfo := GetAttachment.GetDBInformation([isc_info_reads,isc_info_writes,
874		isc_info_fetches, isc_info_num_buffers, isc_info_current_memory,
#	Line 885 | Line 903 | end;
903		procedure TFB25Statement.GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults
904		);
905		begin
906	<	with Firebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
906	>	with FFirebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
907		if isc_dsql_sql_info(StatusVector, @(FHandle), 1, @info_request,
908		GetBufSize, Buffer) > 0 then
909		IBDatabaseError;
#	Line 902 | Line 920 | begin
920		IBError(ibxeEmptyQuery, [nil]);
921		try
922		CheckTransaction(FTransactionIntf);
923	<	with Firebird25ClientAPI do
923	>	with FFirebird25ClientAPI do
924		begin
925		Call(isc_dsql_alloc_statement2(StatusVector, @(FDBHandle),
926		@FHandle), True);
#	Line 910 | Line 928 | begin
928		if FHasParamNames then
929		begin
930		if FProcessedSQL = '' then
931	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
931	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
932		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
933	<	PChar(FProcessedSQL), FSQLDialect, nil), True);
933	>	PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
934		end
935		else
936		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
937	<	PChar(FSQL), FSQLDialect, nil), True);
937	>	PAnsiChar(FSQL), FSQLDialect, nil), True);
938		end;
939		{ After preparing the statement, query the stmt type and possibly
940		create a FSQLRecord "holder" }
#	Line 996 | Line 1014 | begin
1014
1015		try
1016		TRHandle := (aTransaction as TFB25Transaction).Handle;
1017	<	with Firebird25ClientAPI do
1017	>	with FFirebird25ClientAPI do
1018		begin
1019		if FCollectStatistics then
1020		GetPerfCounters(FBeforeStats);
#	Line 1035 | Line 1053 | begin
1053		RemoveMonitor(aTransaction as TFB25Transaction);
1054		end;
1055		FExecTransactionIntf := aTransaction;
1056	+	FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1057	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1058		Inc(FChangeSeqNo);
1059		end;
1060
#	Line 1055 | Line 1075 | begin
1075		if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1076		IBError(ibxeInterfaceOutofDate,[nil]);
1077
1078	<	with Firebird25ClientAPI do
1078	>	with FFirebird25ClientAPI do
1079		begin
1080		if FCollectStatistics then
1081		GetPerfCounters(FBeforeStats);
#	Line 1072 | Line 1092 | begin
1092		CreateGuid(GUID);
1093		FCursor := GUIDToString(GUID);
1094		Call(
1095	<	isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
1095	>	isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1096		True);
1097		end;
1098
#	Line 1094 | Line 1114 | begin
1114		Inc(FChangeSeqNo);
1115		end;
1116
1117	+	procedure TFB25Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1118	+	var processedSQL: AnsiString);
1119	+	begin
1120	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames, processedSQL);
1121	+	end;
1122	+
1123		procedure TFB25Statement.FreeHandle;
1124		var
1125		isc_res: ISC_STATUS;
#	Line 1102 | Line 1128 | begin
1128		ReleaseInterfaces;
1129		try
1130		if FHandle <> nil then
1131	<	with Firebird25ClientAPI do
1131	>	with FFirebird25ClientAPI do
1132		begin
1133		isc_res :=
1134		Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
#	Line 1122 | Line 1148 | var
1148		begin
1149		if (FHandle <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1150		try
1151	<	with Firebird25ClientAPI do
1151	>	with FFirebird25ClientAPI do
1152		begin
1153		isc_res := Call(
1154		isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
#	Line 1133 | Line 1159 | begin
1159		IBDatabaseError;
1160		end;
1161		finally
1162	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1162	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB25Transaction)) then
1163		RemoveMonitor(FSQLRecord.FTransaction);
1164		FOpen := False;
1165		FExecTransactionIntf := nil;
#	Line 1143 | Line 1169 | begin
1169		end;
1170
1171		constructor TFB25Statement.Create(Attachment: TFB25Attachment;
1172	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1172	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1173		begin
1174		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1175		FDBHandle := Attachment.Handle;
1176	+	FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1177	+	OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1178		FSQLParams := TIBXINPUTSQLDA.Create(self);
1179		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1180		InternalPrepare;
1181		end;
1182
1183	<	constructor TFB25Statement.CreateWithParameterNames(Attachment: TFB25Attachment;
1184	<	Transaction: ITransaction; sql: string; aSQLDialect: integer;
1185	<	GenerateParamNames: boolean);
1183	>	constructor TFB25Statement.CreateWithParameterNames(
1184	>	Attachment: TFB25Attachment; Transaction: ITransaction; sql: AnsiString;
1185	>	aSQLDialect: integer; GenerateParamNames: boolean;
1186	>	CaseSensitiveParams: boolean);
1187		begin
1188		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1189		FDBHandle := Attachment.Handle;
1190	+	FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1191	+	OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1192		FSQLParams := TIBXINPUTSQLDA.Create(self);
1193	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1194		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1195		InternalPrepare;
1196		end;
#	Line 1180 | Line 1212 | begin
1212		if FEOF then
1213		IBError(ibxeEOF,[nil]);
1214
1215	<	with Firebird25ClientAPI do
1215	>	with FFirebird25ClientAPI do
1216		begin
1217		{ Go to the next record... }
1218		fetch_res :=
#	Line 1206 | Line 1238 | begin
1238		FBOF := false;
1239		result := true;
1240		end;
1241	+	if FCollectStatistics then
1242	+	begin
1243	+	GetPerfCounters(FAfterStats);
1244	+	FStatisticsAvailable := true;
1245	+	end;
1246		end;
1247		FSQLRecord.RowChange;
1248		if FEOF then
#	Line 1228 | Line 1265 | begin
1265		Result := TMetaData(GetInterface(1));
1266		end;
1267
1268	<	function TFB25Statement.GetPlan: String;
1268	>	function TFB25Statement.GetPlan: AnsiString;
1269		var
1270		RB: ISQLInfoResults;
1271		begin
#	Line 1238 | Line 1275 | begin
1275		result := ''
1276		else
1277		begin
1278	<	RB := TSQLInfoResultsBuffer.Create(4*4096);
1278	>	RB := TSQLInfoResultsBuffer.Create(FFirebird25ClientAPI,4*4096);
1279		GetDsqlInfo(isc_info_sql_get_plan,RB);
1280		if RB.Count > 0 then
1281		Result := RB[0].GetAsString;

Diff Legend

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