ViewVC Help

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

root/public/ibx/trunk/runtime/IBSQL.pas

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC

#	Line 27 | Line 27
27		{    IBX For Lazarus (Firebird Express)                                  }
28		{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29		{    Portions created by MWA Software are copyright McCallum Whyman      }
30	<	{    Associates Ltd 2011                                                 }
30	>	{    Associates Ltd 2011 - 2014                                                }
31		{                                                                        }
32		{************************************************************************}
33
#	Line 35 | Line 35 | unit IBSQL;
35
36		{$Mode Delphi}
37
38	+	{ IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
39	+
40	+	Dialect 3 quoted format parameter names represent a significant overhead and are of
41	+	limited value - especially for users that use only TIBSQL or TIBCustomDataset
42	+	descendents. They were previously used internally by IBX to simplify SQL generation
43	+	for TTable components in Master/Slave relationships which are linked by
44	+	Dialect 3 names. They were also generated by TStoredProc when the original
45	+	parameter names are quoted.
46	+
47	+	However, for some users they do cause a big processing overhead. The TTable/TStoredProc
48	+	code has been re-written so that they are no required by IBX internally.
49	+	The code to support quoted parameter names is now subject  to conditional compilation.
50	+	To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled.
51	+
52	+	Hint: deleting the space between the brace and the dollar sign below
53	+
54	+	}
55	+
56	+	{ $define ALLOWDIALECT3PARAMNAMES}
57	+
58	+	{$ifndef ALLOWDIALECT3PARAMNAMES}
59	+
60	+	{ Even when dialect 3 quoted format parameter names are not supported, IBX still processes
61	+	parameter names case insensitive. This does result in some additional overhead
62	+	due to a call to "AnsiUpperCase". This can be avoided by undefining
63	+	"UseCaseSensitiveParamName" below.
64	+
65	+	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
66	+	is defined. This will not give a useful result.
67	+	}
68	+	{$define UseCaseSensitiveParamName}
69	+	{$endif}
70	+
71		interface
72
73		uses
#	Line 58 | Line 91 | type
91		FIndex: Integer;
92		FModified: Boolean;
93		FName: String;
94	+	FUniqueName: boolean;
95		FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
96
97		function AdjustScale(Value: Int64; Scale: Integer): Double;
#	Line 95 | Line 129 | type
129		procedure SetAsXSQLVAR(Value: PXSQLVAR);
130		procedure SetIsNull(Value: Boolean);
131		procedure SetIsNullable(Value: Boolean);
132	+	procedure xSetAsCurrency(Value: Currency);
133	+	procedure xSetAsInt64(Value: Int64);
134	+	procedure xSetAsDate(Value: TDateTime);
135	+	procedure xSetAsTime(Value: TDateTime);
136	+	procedure xSetAsDateTime(Value: TDateTime);
137	+	procedure xSetAsDouble(Value: Double);
138	+	procedure xSetAsFloat(Value: Float);
139	+	procedure xSetAsLong(Value: Long);
140	+	procedure xSetAsPointer(Value: Pointer);
141	+	procedure xSetAsQuad(Value: TISC_QUAD);
142	+	procedure xSetAsShort(Value: Short);
143	+	procedure xSetAsString(Value: String);
144	+	procedure xSetAsVariant(Value: Variant);
145	+	procedure xSetAsXSQLVAR(Value: PXSQLVAR);
146	+	procedure xSetIsNull(Value: Boolean);
147	+	procedure xSetIsNullable(Value: Boolean);
148		public
149		constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
150		procedure Assign(Source: TIBXSQLVAR);
#	Line 131 | Line 181 | type
181
182		TIBXSQLVARArray = Array of TIBXSQLVAR;
183
184	<	{ TIBXSQLVAR }
184	>	TIBXSQLDAType = (daInput,daOutput);
185	>
186	>	{ TIBXSQLDA }
187	>
188		TIBXSQLDA = class(TObject)
189		protected
190		FSQL: TIBSQL;
191		FCount: Integer;
139	–	FNames: TStrings;
192		FSize: Integer;
193	+	FInputSQLDA: boolean;
194		FXSQLDA: PXSQLDA;
195		FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
196		FUniqueRelationName: String;
197		function GetModified: Boolean;
145	–	function GetNames: String;
198		function GetRecordSize: Integer;
199		function GetXSQLDA: PXSQLDA;
200		function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
#	Line 150 | Line 202 | type
202		procedure Initialize;
203		procedure SetCount(Value: Integer);
204		public
205	<	constructor Create(Query: TIBSQL);
205	>	constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
206		destructor Destroy; override;
207	<	procedure AddName(FieldName: String; Idx: Integer);
207	>	procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
208		function ByName(Idx: String): TIBXSQLVAR;
209		property AsXSQLDA: PXSQLDA read GetXSQLDA;
210		property Count: Integer read FCount write SetCount;
211		property Modified: Boolean read GetModified;
160	–	property Names: String read GetNames;
212		property RecordSize: Integer read GetRecordSize;
213		property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
214		property UniqueRelationName: String read FUniqueRelationName;
#	Line 270 | Line 321 | type
321		TIBSQL = class(TComponent)
322		private
323		FIBLoaded: Boolean;
324	+	FUniqueParamNames: Boolean;
325		function GetFieldCount: integer;
326	+	procedure SetUniqueParamNames(AValue: Boolean);
327		protected
328		FBase: TIBBase;
329		FBOF,                          { At BOF? }
#	Line 340 | Line 393 | type
393		property SQLType: TIBSQLTypes read FSQLType;
394		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
395		property Handle: TISC_STMT_HANDLE read FHandle;
343	–	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
396		property UniqueRelationName: String read GetUniqueRelationName;
397		published
398		property Database: TIBDatabase read GetDatabase write SetDatabase;
399	+	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
400	+	property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
401		property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
402		write FGoToFirstRecordOnExecute
403		default True;
#	Line 937 | Line 991 | begin
991		result := FXSQLVAR^.sqltype and (not 1);
992		end;
993
994	+	procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
995	+	begin
996	+	if IsNullable then
997	+	IsNull := False;
998	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
999	+	FXSQLVAR^.sqlscale := -4;
1000	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1001	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1002	+	PCurrency(FXSQLVAR^.sqldata)^ := Value;
1003	+	FModified := True;
1004	+	end;
1005	+
1006		procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1007		var
942	–	xvar: TIBXSQLVAR;
1008		i: Integer;
1009		begin
1010		if FSQL.Database.SQLDialect < 3 then
1011		AsDouble := Value
1012		else
1013		begin
1014	<	if IsNullable then
1015	<	IsNull := False;
1014	>
1015	>	if FUniqueName then
1016	>	xSetAsCurrency(Value)
1017	>	else
1018		for i := 0 to FParent.FCount - 1 do
1019	<	if FParent.FNames[i] = FName then
1020	<	begin
954	<	xvar := FParent[i];
955	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
956	<	xvar.FXSQLVAR^.sqlscale := -4;
957	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
958	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
959	<	PCurrency(xvar.FXSQLVAR^.sqldata)^ := Value;
960	<	xvar.FModified := True;
961	<	end;
1019	>	if FParent[i].FName = FName then
1020	>	FParent[i].xSetAsCurrency(Value);
1021		end;
1022		end;
1023
1024	+	procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1025	+	begin
1026	+	if IsNullable then
1027	+	IsNull := False;
1028	+
1029	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1030	+	FXSQLVAR^.sqlscale := 0;
1031	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1032	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1033	+	PInt64(FXSQLVAR^.sqldata)^ := Value;
1034	+	FModified := True;
1035	+	end;
1036	+
1037		procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1038		var
1039		i: Integer;
1040	<	xvar: TIBXSQLVAR;
1040	>	begin
1041	>	if FUniqueName then
1042	>	xSetAsInt64(Value)
1043	>	else
1044	>	for i := 0 to FParent.FCount - 1 do
1045	>	if FParent[i].FName = FName then
1046	>	FParent[i].xSetAsInt64(Value);
1047	>	end;
1048	>
1049	>	procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1050	>	var
1051	>	tm_date: TCTimeStructure;
1052	>	Yr, Mn, Dy: Word;
1053		begin
1054		if IsNullable then
1055		IsNull := False;
1056	<	for i := 0 to FParent.FCount - 1 do
1057	<	if FParent.FNames[i] = FName then
1058	<	begin
1059	<	xvar := FParent[i];
1060	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1061	<	xvar.FXSQLVAR^.sqlscale := 0;
1062	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1063	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1064	<	PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1065	<	xvar.FModified := True;
1066	<	end;
1056	>
1057	>	FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1058	>	DecodeDate(Value, Yr, Mn, Dy);
1059	>	with tm_date do begin
1060	>	tm_sec := 0;
1061	>	tm_min := 0;
1062	>	tm_hour := 0;
1063	>	tm_mday := Dy;
1064	>	tm_mon := Mn - 1;
1065	>	tm_year := Yr - 1900;
1066	>	end;
1067	>	FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1068	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1069	>	isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1070	>	FModified := True;
1071		end;
1072
1073		procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1074		var
1075		i: Integer;
988	–	tm_date: TCTimeStructure;
989	–	Yr, Mn, Dy: Word;
990	–	xvar: TIBXSQLVAR;
1076		begin
1077		if FSQL.Database.SQLDialect < 3 then
1078		begin
1079		AsDateTime := Value;
1080		exit;
1081		end;
1082	+
1083	+	if FUniqueName then
1084	+	xSetAsDate(Value)
1085	+	else
1086	+	for i := 0 to FParent.FCount - 1 do
1087	+	if FParent[i].FName = FName then
1088	+	FParent[i].xSetAsDate(Value);
1089	+	end;
1090	+
1091	+	procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1092	+	var
1093	+	tm_date: TCTimeStructure;
1094	+	Hr, Mt, S, Ms: Word;
1095	+	begin
1096		if IsNullable then
1097		IsNull := False;
1098	<	for i := 0 to FParent.FCount - 1 do
1099	<	if FParent.FNames[i] = FName then
1100	<	begin
1101	<	xvar := FParent[i];
1102	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1103	<	DecodeDate(Value, Yr, Mn, Dy);
1104	<	with tm_date do begin
1105	<	tm_sec := 0;
1106	<	tm_min := 0;
1107	<	tm_hour := 0;
1108	<	tm_mday := Dy;
1109	<	tm_mon := Mn - 1;
1110	<	tm_year := Yr - 1900;
1111	<	end;
1112	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1113	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1114	<	isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
1016	<	xvar.FModified := True;
1017	<	end;
1098	>
1099	>	FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1100	>	DecodeTime(Value, Hr, Mt, S, Ms);
1101	>	with tm_date do begin
1102	>	tm_sec := S;
1103	>	tm_min := Mt;
1104	>	tm_hour := Hr;
1105	>	tm_mday := 0;
1106	>	tm_mon := 0;
1107	>	tm_year := 0;
1108	>	end;
1109	>	FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1110	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1111	>	isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1112	>	if Ms > 0 then
1113	>	Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1114	>	FModified := True;
1115		end;
1116
1117		procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1118		var
1119		i: Integer;
1023	–	tm_date: TCTimeStructure;
1024	–	Hr, Mt, S, Ms: Word;
1025	–	xvar: TIBXSQLVAR;
1120		begin
1121		if FSQL.Database.SQLDialect < 3 then
1122		begin
1123		AsDateTime := Value;
1124		exit;
1125		end;
1126	<	if IsNullable then
1127	<	IsNull := False;
1126	>
1127	>	if FUniqueName then
1128	>	xSetAsTime(Value)
1129	>	else
1130		for i := 0 to FParent.FCount - 1 do
1131	<	if FParent.FNames[i] = FName then
1132	<	begin
1037	<	xvar := FParent[i];
1038	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR^.sqltype and 1);
1039	<	DecodeTime(Value, Hr, Mt, S, Ms);
1040	<	with tm_date do begin
1041	<	tm_sec := S;
1042	<	tm_min := Mt;
1043	<	tm_hour := Hr;
1044	<	tm_mday := 0;
1045	<	tm_mon := 0;
1046	<	tm_year := 0;
1047	<	end;
1048	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1049	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1050	<	isc_encode_sql_time(@tm_date, PISC_TIME(xvar.FXSQLVAR^.sqldata));
1051	<	if Ms > 0 then
1052	<	Inc(PISC_TIME(xvar.FXSQLVAR^.sqldata)^,Ms*10);
1053	<	xvar.FModified := True;
1054	<	end;
1131	>	if FParent[i].FName = FName then
1132	>	FParent[i].xSetAsTime(Value);
1133		end;
1134
1135	<	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1135	>	procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1136		var
1059	–	i: Integer;
1137		tm_date: TCTimeStructure;
1138		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1062	–	xvar: TIBXSQLVAR;
1139		begin
1140		if IsNullable then
1141		IsNull := False;
1142	+
1143	+	FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1144	+	DecodeDate(Value, Yr, Mn, Dy);
1145	+	DecodeTime(Value, Hr, Mt, S, Ms);
1146	+	with tm_date do begin
1147	+	tm_sec := S;
1148	+	tm_min := Mt;
1149	+	tm_hour := Hr;
1150	+	tm_mday := Dy;
1151	+	tm_mon := Mn - 1;
1152	+	tm_year := Yr - 1900;
1153	+	end;
1154	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1155	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1156	+	isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1157	+	if Ms > 0 then
1158	+	Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1159	+	FModified := True;
1160	+	end;
1161	+
1162	+	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1163	+	var
1164	+	i: Integer;
1165	+	begin
1166	+	if FUniqueName then
1167	+	xSetAsDateTime(value)
1168	+	else
1169		for i := 0 to FParent.FCount - 1 do
1170	<	if FParent.FNames[i] = FName then
1171	<	begin
1172	<	xvar := FParent[i];
1173	<	xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1174	<	DecodeDate(Value, Yr, Mn, Dy);
1175	<	DecodeTime(Value, Hr, Mt, S, Ms);
1176	<	with tm_date do begin
1177	<	tm_sec := S;
1178	<	tm_min := Mt;
1179	<	tm_hour := Hr;
1180	<	tm_mday := Dy;
1181	<	tm_mon := Mn - 1;
1182	<	tm_year := Yr - 1900;
1183	<	end;
1184	<	xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1082	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1083	<	isc_encode_date(@tm_date, PISC_QUAD(xvar.FXSQLVAR^.sqldata));
1084	<	if Ms > 0 then
1085	<	Inc(PISC_TIMESTAMP(xvar.FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1086	<	xvar.FModified := True;
1087	<	end;
1170	>	if FParent[i].FName = FName then
1171	>	FParent[i].xSetAsDateTime(Value);
1172	>	end;
1173	>
1174	>	procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1175	>	begin
1176	>	if IsNullable then
1177	>	IsNull := False;
1178	>
1179	>	FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1180	>	FXSQLVAR^.sqllen := SizeOf(Double);
1181	>	FXSQLVAR^.sqlscale := 0;
1182	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1183	>	PDouble(FXSQLVAR^.sqldata)^ := Value;
1184	>	FModified := True;
1185		end;
1186
1187		procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1188		var
1189		i: Integer;
1190	<	xvar: TIBXSQLVAR;
1190	>	begin
1191	>	if FUniqueName then
1192	>	xSetAsDouble(Value)
1193	>	else
1194	>	for i := 0 to FParent.FCount - 1 do
1195	>	if FParent[i].FName = FName then
1196	>	FParent[i].xSetAsDouble(Value);
1197	>	end;
1198	>
1199	>	procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1200		begin
1201		if IsNullable then
1202		IsNull := False;
1203	<	for i := 0 to FParent.FCount - 1 do
1204	<	if FParent.FNames[i] = FName then
1205	<	begin
1206	<	xvar := FParent[i];
1207	<	xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1208	<	xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1209	<	xvar.FXSQLVAR^.sqlscale := 0;
1104	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1105	<	PDouble(xvar.FXSQLVAR^.sqldata)^ := Value;
1106	<	xvar.FModified := True;
1107	<	end;
1203	>
1204	>	FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1205	>	FXSQLVAR^.sqllen := SizeOf(Float);
1206	>	FXSQLVAR^.sqlscale := 0;
1207	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1208	>	PSingle(FXSQLVAR^.sqldata)^ := Value;
1209	>	FModified := True;
1210		end;
1211
1212		procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1213		var
1214		i: Integer;
1215	<	xvar: TIBXSQLVAR;
1215	>	begin
1216	>	if FUniqueName then
1217	>	xSetAsFloat(Value)
1218	>	else
1219	>	for i := 0 to FParent.FCount - 1 do
1220	>	if FParent[i].FName = FName then
1221	>	FParent[i].xSetAsFloat(Value);
1222	>	end;
1223	>
1224	>	procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1225		begin
1226		if IsNullable then
1227		IsNull := False;
1228	<	for i := 0 to FParent.FCount - 1 do
1229	<	if FParent.FNames[i] = FName then
1230	<	begin
1231	<	xvar := FParent[i];
1232	<	xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1233	<	xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1234	<	xvar.FXSQLVAR^.sqlscale := 0;
1124	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1125	<	PSingle(xvar.FXSQLVAR^.sqldata)^ := Value;
1126	<	xvar.FModified := True;
1127	<	end;
1228	>
1229	>	FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1230	>	FXSQLVAR^.sqllen := SizeOf(Long);
1231	>	FXSQLVAR^.sqlscale := 0;
1232	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1233	>	PLong(FXSQLVAR^.sqldata)^ := Value;
1234	>	FModified := True;
1235		end;
1236
1237		procedure TIBXSQLVAR.SetAsLong(Value: Long);
1238		var
1239		i: Integer;
1133	–	xvar: TIBXSQLVAR;
1240		begin
1241	<	if IsNullable then
1242	<	IsNull := False;
1241	>	if FUniqueName then
1242	>	xSetAsLong(Value)
1243	>	else
1244		for i := 0 to FParent.FCount - 1 do
1245	<	if FParent.FNames[i] = FName then
1246	<	begin
1140	<	xvar := FParent[i];
1141	<	xvar.FXSQLVAR^.sqltype := SQL_LONG or (xvar.FXSQLVAR^.sqltype and 1);
1142	<	xvar.FXSQLVAR^.sqllen := SizeOf(Long);
1143	<	xvar.FXSQLVAR^.sqlscale := 0;
1144	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1145	<	PLong(xvar.FXSQLVAR^.sqldata)^ := Value;
1146	<	xvar.FModified := True;
1147	<	end;
1245	>	if FParent[i].FName = FName then
1246	>	FParent[i].xSetAsLong(Value);
1247		end;
1248
1249	<	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1151	<	var
1152	<	i: Integer;
1153	<	xvar: TIBXSQLVAR;
1249	>	procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1250		begin
1251		if IsNullable and (Value = nil) then
1252		IsNull := True
1253		else begin
1254		IsNull := False;
1255	<	for i := 0 to FParent.FCount - 1 do
1256	<	if FParent.FNames[i] = FName then
1161	<	begin
1162	<	xvar := FParent[i];
1163	<	xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1164	<	Move(Value^, xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1165	<	xvar.FModified := True;
1166	<	end;
1255	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1256	>	Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1257		end;
1258	+	FModified := True;
1259	+	end;
1260	+
1261	+	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1262	+	var
1263	+	i: Integer;
1264	+	begin
1265	+	if FUniqueName then
1266	+	xSetAsPointer(Value)
1267	+	else
1268	+	for i := 0 to FParent.FCount - 1 do
1269	+	if FParent[i].FName = FName then
1270	+	FParent[i].xSetAsPointer(Value);
1271	+	end;
1272	+
1273	+	procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1274	+	begin
1275	+	if IsNullable then
1276	+	IsNull := False;
1277	+	if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1278	+	(FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1279	+	IBError(ibxeInvalidDataConversion, [nil]);
1280	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1281	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1282	+	PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1283	+	FModified := True;
1284		end;
1285
1286		procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1287		var
1288		i: Integer;
1289	<	xvar: TIBXSQLVAR;
1289	>	begin
1290	>	if FUniqueName then
1291	>	xSetAsQuad(Value)
1292	>	else
1293	>	for i := 0 to FParent.FCount - 1 do
1294	>	if FParent[i].FName = FName then
1295	>	FParent[i].xSetAsQuad(Value);
1296	>	end;
1297	>
1298	>	procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1299		begin
1300		if IsNullable then
1301		IsNull := False;
1302	<	for i := 0 to FParent.FCount - 1 do
1303	<	if FParent.FNames[i] = FName then
1304	<	begin
1305	<	xvar := FParent[i];
1306	<	if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1307	<	(xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1308	<	IBError(ibxeInvalidDataConversion, [nil]);
1184	<	xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1185	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1186	<	PISC_QUAD(xvar.FXSQLVAR^.sqldata)^ := Value;
1187	<	xvar.FModified := True;
1188	<	end;
1302	>
1303	>	FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1304	>	FXSQLVAR^.sqllen := SizeOf(Short);
1305	>	FXSQLVAR^.sqlscale := 0;
1306	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1307	>	PShort(FXSQLVAR^.sqldata)^ := Value;
1308	>	FModified := True;
1309		end;
1310
1311		procedure TIBXSQLVAR.SetAsShort(Value: Short);
1312		var
1313		i: Integer;
1194	–	xvar: TIBXSQLVAR;
1314		begin
1315	<	if IsNullable then
1316	<	IsNull := False;
1315	>	if FUniqueName then
1316	>	xSetAsShort(Value)
1317	>	else
1318		for i := 0 to FParent.FCount - 1 do
1319	<	if FParent.FNames[i] = FName then
1320	<	begin
1201	<	xvar := FParent[i];
1202	<	xvar.FXSQLVAR^.sqltype := SQL_SHORT or (xvar.FXSQLVAR^.sqltype and 1);
1203	<	xvar.FXSQLVAR^.sqllen := SizeOf(Short);
1204	<	xvar.FXSQLVAR^.sqlscale := 0;
1205	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1206	<	PShort(xvar.FXSQLVAR^.sqldata)^ := Value;
1207	<	xvar.FModified := True;
1208	<	end;
1319	>	if FParent[i].FName = FName then
1320	>	FParent[i].xSetAsShort(Value);
1321		end;
1322
1323	<	procedure TIBXSQLVAR.SetAsString(Value: String);
1323	>	procedure TIBXSQLVAR.xSetAsString(Value: String);
1324		var
1325	<	stype: Integer;
1326	<	ss: TStringStream;
1325	>	stype: Integer;
1326	>	ss: TStringStream;
1327
1328	<	procedure SetStringValue;
1329	<	var
1330	<	i: Integer;
1331	<	xvar: TIBXSQLVAR;
1332	<	begin
1333	<	for i := 0 to FParent.FCount - 1 do
1334	<	if FParent.FNames[i] = FName then
1335	<	begin
1336	<	xvar := FParent[i];
1337	<	if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1338	<	(xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1339	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1340	<	else begin
1229	<	xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1230	<	xvar.FXSQLVAR^.sqllen := Length(Value);
1231	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen + 1);
1232	<	if (Length(Value) > 0) then
1233	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1234	<	end;
1235	<	xvar.FModified := True;
1328	>	procedure SetStringValue;
1329	>	var
1330	>	i: Integer;
1331	>	begin
1332	>	if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1333	>	(FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1334	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1335	>	else begin
1336	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1337	>	FXSQLVAR^.sqllen := Length(Value);
1338	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1339	>	if (Length(Value) > 0) then
1340	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1341		end;
1342	<	end;
1342	>	FModified := True;
1343	>	end;
1344
1345		begin
1346		if IsNullable then
1347		IsNull := False;
1348	+
1349		stype := FXSQLVAR^.sqltype and (not 1);
1350		if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1351		SetStringValue
#	Line 1256 | Line 1363 | begin
1363		IsNull := True
1364		else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1365		(stype = SQL_TYPE_TIME) then
1366	<	SetAsDateTime(StrToDateTime(Value))
1366	>	xSetAsDateTime(StrToDateTime(Value))
1367		else
1368		SetStringValue;
1369		end;
1370		end;
1371
1372	<	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1372	>	procedure TIBXSQLVAR.SetAsString(Value: String);
1373	>	var
1374	>	i: integer;
1375	>	begin
1376	>	if FUniqueName then
1377	>	xSetAsString(Value)
1378	>	else
1379	>	for i := 0 to FParent.FCount - 1 do
1380	>	if FParent[i].FName = FName then
1381	>	FParent[i].xSetAsString(Value);
1382	>	end;
1383	>
1384	>	procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1385		begin
1386		if VarIsNull(Value) then
1387		IsNull := True
1388		else case VarType(Value) of
1389		varEmpty, varNull:
1390		IsNull := True;
1391	<	varSmallint, varInteger, varByte:
1391	>	varSmallint, varInteger, varByte,
1392	>	varWord, varShortInt:
1393		AsLong := Value;
1394	+	varInt64:
1395	+	AsInt64 := Value;
1396		varSingle, varDouble:
1397		AsDouble := Value;
1398		varCurrency:
#	Line 1291 | Line 1413 | begin
1413		end;
1414		end;
1415
1416	<	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1416	>	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1417	>	var
1418	>	i: integer;
1419	>	begin
1420	>	if FUniqueName then
1421	>	xSetAsVariant(Value)
1422	>	else
1423	>	for i := 0 to FParent.FCount - 1 do
1424	>	if FParent[i].FName = FName then
1425	>	FParent[i].xSetAsVariant(Value);
1426	>	end;
1427	>
1428	>	procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1429		var
1296	–	i: Integer;
1297	–	xvar: TIBXSQLVAR;
1430		sqlind: PShort;
1431		sqldata: PChar;
1432		local_sqllen: Integer;
1433		begin
1434	<	for i := 0 to FParent.FCount - 1 do
1435	<	if FParent.FNames[i] = FName then
1436	<	begin
1437	<	xvar := FParent[i];
1438	<	sqlind := xvar.FXSQLVAR^.sqlind;
1439	<	sqldata := xvar.FXSQLVAR^.sqldata;
1440	<	Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1441	<	xvar.FXSQLVAR^.sqlind := sqlind;
1442	<	xvar.FXSQLVAR^.sqldata := sqldata;
1443	<	if (Value^.sqltype and 1 = 1) then
1444	<	begin
1445	<	if (xvar.FXSQLVAR^.sqlind = nil) then
1446	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1447	<	xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1448	<	end
1449	<	else
1450	<	if (xvar.FXSQLVAR^.sqlind <> nil) then
1451	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1452	<	if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1453	<	local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1454	<	else
1455	<	local_sqllen := xvar.FXSQLVAR^.sqllen;
1324	<	FXSQLVAR^.sqlscale := Value^.sqlscale;
1325	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen);
1326	<	Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen);
1327	<	xvar.FModified := True;
1328	<	end;
1434	>	sqlind := FXSQLVAR^.sqlind;
1435	>	sqldata := FXSQLVAR^.sqldata;
1436	>	Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1437	>	FXSQLVAR^.sqlind := sqlind;
1438	>	FXSQLVAR^.sqldata := sqldata;
1439	>	if (Value^.sqltype and 1 = 1) then
1440	>	begin
1441	>	if (FXSQLVAR^.sqlind = nil) then
1442	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1443	>	FXSQLVAR^.sqlind^ := Value^.sqlind^;
1444	>	end
1445	>	else
1446	>	if (FXSQLVAR^.sqlind <> nil) then
1447	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1448	>	if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1449	>	local_sqllen := FXSQLVAR^.sqllen + 2
1450	>	else
1451	>	local_sqllen := FXSQLVAR^.sqllen;
1452	>	FXSQLVAR^.sqlscale := Value^.sqlscale;
1453	>	IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1454	>	Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1455	>	FModified := True;
1456		end;
1457
1458	<	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1458	>	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1459		var
1460		i: Integer;
1461	<	xvar: TIBXSQLVAR;
1461	>	begin
1462	>	if FUniqueName then
1463	>	xSetAsXSQLVAR(Value)
1464	>	else
1465	>	for i := 0 to FParent.FCount - 1 do
1466	>	if FParent[i].FName = FName then
1467	>	FParent[i].xSetAsXSQLVAR(Value);
1468	>	end;
1469	>
1470	>	procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1471		begin
1472		if Value then
1473		begin
1474		if not IsNullable then
1475		IsNullable := True;
1476	<	for i := 0 to FParent.FCount - 1 do
1477	<	if FParent.FNames[i] = FName then
1478	<	begin
1479	<	xvar := FParent[i];
1344	<	if Assigned(xvar.FXSQLVAR^.sqlind) then
1345	<	xvar.FXSQLVAR^.sqlind^ := -1;
1346	<	xvar.FModified := True;
1347	<	end;
1476	>
1477	>	if Assigned(FXSQLVAR^.sqlind) then
1478	>	FXSQLVAR^.sqlind^ := -1;
1479	>	FModified := True;
1480		end
1481		else
1482		if ((not Value) and IsNullable) then
1483		begin
1484	<	for i := 0 to FParent.FCount - 1 do
1485	<	if FParent.FNames[i] = FName then
1486	<	begin
1355	<	xvar := FParent[i];
1356	<	if Assigned(xvar.FXSQLVAR^.sqlind) then
1357	<	xvar.FXSQLVAR^.sqlind^ := 0;
1358	<	xvar.FModified := True;
1359	<	end;
1484	>	if Assigned(FXSQLVAR^.sqlind) then
1485	>	FXSQLVAR^.sqlind^ := 0;
1486	>	FModified := True;
1487		end;
1488		end;
1489
1490	<	procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1490	>	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1491		var
1492		i: Integer;
1366	–	xvar: TIBXSQLVAR;
1493		begin
1494	+	if FUniqueName then
1495	+	xSetIsNull(Value)
1496	+	else
1497		for i := 0 to FParent.FCount - 1 do
1498	<	if FParent.FNames[i] = FName then
1498	>	if FParent[i].FName = FName then
1499	>	FParent[i].xSetIsNull(Value);
1500	>	end;
1501	>
1502	>	procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1503	>	begin
1504	>	if (Value <> IsNullable) then
1505	>	begin
1506	>	if Value then
1507		begin
1508	<	xvar := FParent[i];
1509	<	if (Value <> IsNullable) then
1510	<	begin
1511	<	if Value then
1512	<	begin
1513	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1514	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1378	<	end
1379	<	else
1380	<	begin
1381	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1382	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1383	<	end;
1384	<	end;
1508	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1509	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1510	>	end
1511	>	else
1512	>	begin
1513	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1514	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1515		end;
1516	+	end;
1517	+	end;
1518	+
1519	+	procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1520	+	var
1521	+	i: Integer;
1522	+	begin
1523	+	if FUniqueName then
1524	+	xSetIsNullable(Value)
1525	+	else
1526	+	for i := 0 to FParent.FCount - 1 do
1527	+	if FParent[i].FName = FName then
1528	+	FParent[i].xSetIsNullable(Value);
1529		end;
1530
1531		procedure TIBXSQLVAR.Clear;
#	Line 1392 | Line 1535 | end;
1535
1536
1537		{ TIBXSQLDA }
1538	<	constructor TIBXSQLDA.Create(Query: TIBSQL);
1538	>	constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1539		begin
1540		inherited Create;
1541		FSQL := Query;
1399	–	FNames := TStringList.Create;
1542		FSize := 0;
1543		FUniqueRelationName := '';
1544	+	FInputSQLDA := sqldaType = daInput;
1545		end;
1546
1547		destructor TIBXSQLDA.Destroy;
1548		var
1549		i: Integer;
1550		begin
1408	–	FNames.Free;
1551		if FXSQLDA <> nil then
1552		begin
1553		for i := 0 to FSize - 1 do
#	Line 1421 | Line 1563 | begin
1563		inherited Destroy;
1564		end;
1565
1566	<	procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1566	>	procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1567	>	UniqueName: boolean);
1568		var
1569	<	fn: String;
1569	>	fn: string;
1570		begin
1571	<	fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1572	<	while FNames.Count <= Idx do
1573	<	FNames.Add('');
1574	<	FNames[Idx] := fn;
1575	<	FXSQLVARs[Idx].FName := fn;
1571	>	{$ifdef UseCaseSensitiveParamName}
1572	>	FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1573	>	{$else}
1574	>	FXSQLVARs[Idx].FName := FieldName;
1575	>	{$endif}
1576		FXSQLVARs[Idx].FIndex := Idx;
1577	+	FXSQLVARs[Idx].FUniqueName :=  UniqueName
1578		end;
1579
1580		function TIBXSQLDA.GetModified: Boolean;
#	Line 1446 | Line 1590 | begin
1590		end;
1591		end;
1592
1449	–	function TIBXSQLDA.GetNames: String;
1450	–	begin
1451	–	result := FNames.Text;
1452	–	end;
1453	–
1593		function TIBXSQLDA.GetRecordSize: Integer;
1594		begin
1595		result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
#	Line 1478 | Line 1617 | end;
1617		function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1618		var
1619		s: String;
1620	<	i, Cnt: Integer;
1620	>	i: Integer;
1621		begin
1622	<	s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1623	<	i := 0;
1624	<	Cnt := FNames.Count;
1625	<	while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1626	<	if i = Cnt then
1627	<	result := nil
1628	<	else
1629	<	result := GetXSQLVAR(i);
1622	>	{$ifdef ALLOWDIALECT3PARAMNAMES}
1623	>	s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1624	>	{$else}
1625	>	{$ifdef UseCaseSensitiveParamName}
1626	>	s := AnsiUpperCase(Idx);
1627	>	{$else}
1628	>	s := Idx;
1629	>	{$endif}
1630	>	{$endif}
1631	>	for i := 0 to FCount - 1 do
1632	>	if Vars[i].FName = s then
1633	>	begin
1634	>	Result := FXSQLVARs[i];
1635	>	Exit;
1636	>	end;
1637	>	Result := nil;
1638		end;
1639
1640		procedure TIBXSQLDA.Initialize;
1641	+
1642	+	function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1643	+	var
1644	+	k: integer;
1645	+	begin
1646	+	for k := 0 to limit do
1647	+	if FXSQLVARs[k].FName = idx then
1648	+	begin
1649	+	Result := FXSQLVARs[k];
1650	+	Exit;
1651	+	end;
1652	+	Result := nil;
1653	+	end;
1654	+
1655		var
1656		i, j, j_len: Integer;
1496	–	NamesWereEmpty: Boolean;
1657		st: String;
1658		bUnique: Boolean;
1659	+	sBaseName: string;
1660		begin
1661		bUnique := True;
1501	–	NamesWereEmpty := (FNames.Count = 0);
1662		if FXSQLDA <> nil then
1663		begin
1664		for i := 0 to FCount - 1 do
1665		begin
1666		with FXSQLVARs[i].Data^ do
1667		begin
1668	+
1669	+	{First get the unique relation name, if any}
1670	+
1671		if bUnique and (strpas(relname) <> '') then
1672		begin
1673		if FUniqueRelationName = '' then
#	Line 1516 | Line 1679 | begin
1679		bUnique := False;
1680		end;
1681		end;
1682	<	if NamesWereEmpty then
1682	>
1683	>	{If an output SQLDA then copy the aliasnames to the FName list. Ensure
1684	>	that they are all upper case only and disambiguated.
1685	>	}
1686	>
1687	>	if not FInputSQLDA then
1688		begin
1689	<	st := strpas(aliasname);
1689	>	st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1690		if st = '' then
1691		begin
1692	<	st := 'F_'; {do not localize}
1692	>	sBaseName := 'F_'; {do not localize}
1693		aliasname_length := 2;
1694		j := 1; j_len := 1;
1695	<	StrPCopy(aliasname, st + IntToStr(j));
1695	>	st := sBaseName + IntToStr(j);
1696		end
1697		else
1698		begin
1531	–	StrPCopy(aliasname, st);
1699		j := 0; j_len := 0;
1700	+	sBaseName := st;
1701		end;
1702	<	while GetXSQLVARByName(strpas(aliasname)) <> nil do
1702	>
1703	>	{Look for other columns with the same name and make unique}
1704	>
1705	>	while VarByName(st,i-1) <> nil do
1706		begin
1707	<	Inc(j); j_len := Length(IntToStr(j));
1708	<	if j_len + aliasname_length > 31 then
1709	<	StrPCopy(aliasname,
1710	<	Copy(st, 1, 31 - j_len) +
1711	<	IntToStr(j))
1712	<	else
1542	<	StrPCopy(aliasname, st + IntToStr(j));
1707	>	Inc(j);
1708	>	j_len := Length(IntToStr(j));
1709	>	if j_len + Length(sBaseName) > 31 then
1710	>	st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1711	>	else
1712	>	st := sBaseName + IntToStr(j);
1713		end;
1714	<	Inc(aliasname_length, j_len);
1715	<	AddName(strpas(aliasname), i);
1714	>
1715	>	FXSQLVARs[i].FName := st;
1716		end;
1717	+
1718	+	{Finally initialise the XSQLVAR}
1719	+
1720	+	FXSQLVARs[i].FIndex := i;
1721	+
1722		case sqltype and (not 1) of
1723		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1724		SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
#	Line 1576 | Line 1751 | var
1751		i, OldSize: Integer;
1752		p : PXSQLVAR;
1753		begin
1579	–	FNames.Clear;
1754		FCount := Value;
1755		if FCount = 0 then
1756		FUniqueRelationName := ''
#	Line 1935 | Line 2109 | begin
2109		TStringList(FSQL).OnChanging := SQLChanging;
2110		FProcessedSQL := TStringList.Create;
2111		FHandle := nil;
2112	<	FSQLParams := TIBXSQLDA.Create(self);
2113	<	FSQLRecord := TIBXSQLDA.Create(self);
2112	>	FSQLParams := TIBXSQLDA.Create(self,daInput);
2113	>	FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2114		FSQLType := SQLUnknown;
2115		FParamCheck := True;
2116		FCursor := Name + RandomString(8);
#	Line 2054 | Line 2228 | begin
2228		Result := FSQLRecord.Count
2229		end;
2230
2231	+	procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2232	+	begin
2233	+	if FUniqueParamNames = AValue then Exit;
2234	+	FreeHandle;
2235	+	FUniqueParamNames := AValue;
2236	+	end;
2237	+
2238		procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2239		begin
2240		if (FHandle <> nil) then begin
#	Line 2093 | Line 2274 | begin
2274		@FHandle,
2275		Database.SQLDialect,
2276		FSQLParams.AsXSQLDA,
2277	<	FSQLRecord.AsXSQLDA), False);
2278	<	if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2277	>	FSQLRecord.AsXSQLDA), True);
2278	>	(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2279		begin
2280		{ Sometimes a prepared stored procedure appears to get
2281		off sync on the server ....This code is meant to try
#	Line 2109 | Line 2290 | begin
2290		Database.SQLDialect,
2291		FSQLParams.AsXSQLDA,
2292		FSQLRecord.AsXSQLDA), True);
2293	<	end;
2293	>	end;  *)
2294		end
2295		else
2296		Call(isc_dsql_execute(StatusVector,
#	Line 2249 | Line 2430 | begin
2430		result := FRecordCount;
2431		end;
2432
2433	<	function TIBSQL.GetRowsAffected: integer;
2433	>	function TIBSQL.GetRowsAffected: Integer;
2434		var
2435		result_buffer: array[0..1048] of Char;
2436		info_request: Char;
#	Line 2300 | Line 2481 | var
2481		cCurChar, cNextChar, cQuoteChar: Char;
2482		sSQL, sProcessedSQL, sParamName: String;
2483		i, iLenSQL, iSQLPos: Integer;
2484	<	iCurState, iCurParamState: Integer;
2484	>	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2485		iParamSuffix: Integer;
2486		slNames: TStrings;
2487
#	Line 2309 | Line 2490 | const
2490		CommentState = 1;
2491		QuoteState = 2;
2492		ParamState = 3;
2493	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2494		ParamDefaultState = 0;
2495		ParamQuoteState = 1;
2496	+	{$endif}
2497
2498		procedure AddToProcessedSQL(cChar: Char);
2499		begin
#	Line 2330 | Line 2513 | begin
2513		i := 1;
2514		iSQLPos := 1;
2515		iCurState := DefaultState;
2516	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2517		iCurParamState := ParamDefaultState;
2518	+	{$endif}
2519		{ Now, traverse through the SQL string, character by character,
2520		picking out the parameters and formatting correctly for InterBase }
2521		while (i <= iLenSQL) do begin
#	Line 2381 | Line 2566 | begin
2566		ParamState:
2567		begin
2568		{ collect the name of the parameter }
2569	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2570		if iCurParamState = ParamDefaultState then
2571		begin
2572		if cCurChar = '"' then
2573		iCurParamState := ParamQuoteState
2574	<	else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2574	>	else
2575	>	{$endif}
2576	>	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2577		sParamName := sParamName + cCurChar
2578		else if FGenerateParamNames then
2579		begin
2580		sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2581		Inc(iParamSuffix);
2582		iCurState := DefaultState;
2583	<	slNames.Add(sParamName);
2583	>	slNames.AddObject(sParamName,self); //Note local convention
2584	>	//add pointer to self to mark entry
2585		sParamName := '';
2586		end
2587		else
2588		IBError(ibxeSQLParseError, [SParamNameExpected]);
2589	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2590		end
2591		else begin
2592		{ determine if Quoted parameter name is finished }
#	Line 2411 | Line 2601 | begin
2601		else
2602		sParamName := sParamName + cCurChar
2603		end;
2604	+	{$endif}
2605		{ determine if the unquoted parameter name is finished }
2606	<	if (iCurParamState <> ParamQuoteState) and
2606	>	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2607		(iCurState <> DefaultState) then
2608		begin
2609		if not (cNextChar in ['A'..'Z', 'a'..'z',
#	Line 2432 | Line 2623 | begin
2623		AddToProcessedSQL(#0);
2624		FSQLParams.Count := slNames.Count;
2625		for i := 0 to slNames.Count - 1 do
2626	<	FSQLParams.AddName(slNames[i], i);
2626	>	FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2627		FProcessedSQL.Text := sProcessedSQL;
2628		finally
2629		slNames.Free;

Diff Legend

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