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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 21 by tony, Thu Feb 26 10:33:34 2015 UTC

#	Line 24 | Line 24
24		{       Corporation. All Rights Reserved.                                }
25		{    Contributor(s): Jeff Overcash                                       }
26		{                                                                        }
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 - 2014                                                }
31	+	{                                                                        }
32		{************************************************************************}
33
34		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
74	<	{$IFDEF LINUX }
37	<	baseunix,unix,
38	<	{$ELSE}
39	<	{$DEFINE HAS_SQLMONITOR}
74	>	{$IFDEF WINDOWS }
75		Windows,
76	+	{$ELSE}
77	+	baseunix, unix,
78		{$ENDIF}
79		SysUtils, Classes, Forms, Controls, IBHeader,
80		IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
81
82	+	const
83	+	sSQLErrorSeparator = ' When Executing: ';
84	+
85		type
86		TIBSQL = class;
87		TIBXSQLDA = class;
#	Line 54 | Line 94 | type
94		FIndex: Integer;
95		FModified: Boolean;
96		FName: String;
97	+	FUniqueName: boolean;
98		FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
99
100		function AdjustScale(Value: Int64; Scale: Integer): Double;
#	Line 91 | Line 132 | type
132		procedure SetAsXSQLVAR(Value: PXSQLVAR);
133		procedure SetIsNull(Value: Boolean);
134		procedure SetIsNullable(Value: Boolean);
135	+	procedure xSetAsCurrency(Value: Currency);
136	+	procedure xSetAsInt64(Value: Int64);
137	+	procedure xSetAsDate(Value: TDateTime);
138	+	procedure xSetAsTime(Value: TDateTime);
139	+	procedure xSetAsDateTime(Value: TDateTime);
140	+	procedure xSetAsDouble(Value: Double);
141	+	procedure xSetAsFloat(Value: Float);
142	+	procedure xSetAsLong(Value: Long);
143	+	procedure xSetAsPointer(Value: Pointer);
144	+	procedure xSetAsQuad(Value: TISC_QUAD);
145	+	procedure xSetAsShort(Value: Short);
146	+	procedure xSetAsString(Value: String);
147	+	procedure xSetAsVariant(Value: Variant);
148	+	procedure xSetAsXSQLVAR(Value: PXSQLVAR);
149	+	procedure xSetIsNull(Value: Boolean);
150	+	procedure xSetIsNullable(Value: Boolean);
151		public
152		constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
153		procedure Assign(Source: TIBXSQLVAR);
154	+	procedure Clear;
155		procedure LoadFromFile(const FileName: String);
156		procedure LoadFromStream(Stream: TStream);
157		procedure SaveToFile(const FileName: String);
#	Line 126 | Line 184 | type
184
185		TIBXSQLVARArray = Array of TIBXSQLVAR;
186
187	<	{ TIBXSQLVAR }
187	>	TIBXSQLDAType = (daInput,daOutput);
188	>
189	>	{ TIBXSQLDA }
190	>
191		TIBXSQLDA = class(TObject)
192		protected
193		FSQL: TIBSQL;
194		FCount: Integer;
134	–	FNames: TStrings;
195		FSize: Integer;
196	+	FInputSQLDA: boolean;
197		FXSQLDA: PXSQLDA;
198		FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
199		FUniqueRelationName: String;
200		function GetModified: Boolean;
140	–	function GetNames: String;
201		function GetRecordSize: Integer;
202		function GetXSQLDA: PXSQLDA;
203		function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
#	Line 145 | Line 205 | type
205		procedure Initialize;
206		procedure SetCount(Value: Integer);
207		public
208	<	constructor Create(Query: TIBSQL);
208	>	constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
209		destructor Destroy; override;
210	<	procedure AddName(FieldName: String; Idx: Integer);
210	>	procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
211		function ByName(Idx: String): TIBXSQLVAR;
212		property AsXSQLDA: PXSQLDA read GetXSQLDA;
213		property Count: Integer read FCount write SetCount;
214		property Modified: Boolean read GetModified;
155	–	property Names: String read GetNames;
215		property RecordSize: Integer read GetRecordSize;
216		property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
217		property UniqueRelationName: String read FUniqueRelationName;
#	Line 186 | Line 245 | type
245		{ TIBOutputDelimitedFile }
246		TIBOutputDelimitedFile = class(TIBBatchOutput)
247		protected
248	<	{$IFDEF LINUX}
248	>	{$IFDEF UNIX}
249		FHandle: cint;
250		{$ELSE}
251		FHandle: THandle;
#	Line 229 | Line 288 | type
288		{ TIBOutputRawFile }
289		TIBOutputRawFile = class(TIBBatchOutput)
290		protected
291	<	{$IFDEF LINUX}
291	>	{$IFDEF UNIX}
292		FHandle: cint;
293		{$ELSE}
294		FHandle: THandle;
#	Line 243 | Line 302 | type
302		{ TIBInputRawFile }
303		TIBInputRawFile = class(TIBBatchInput)
304		protected
305	<	{$IFDEF LINUX}
305	>	{$IFDEF UNIX}
306		FHandle: cint;
307		{$ELSE}
308		FHandle: THandle;
#	Line 265 | Line 324 | type
324		TIBSQL = class(TComponent)
325		private
326		FIBLoaded: Boolean;
327	+	FUniqueParamNames: Boolean;
328	+	function GetFieldCount: integer;
329	+	procedure SetUniqueParamNames(AValue: Boolean);
330		protected
331		FBase: TIBBase;
332		FBOF,                          { At BOF? }
#	Line 324 | Line 386 | type
386		property Eof: Boolean read GetEOF;
387		property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
388		property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
389	+	property FieldCount: integer read GetFieldCount;
390		property Open: Boolean read FOpen;
391		property Params: TIBXSQLDA read GetSQLParams;
392		property Plan: String read GetPlan;
#	Line 333 | Line 396 | type
396		property SQLType: TIBSQLTypes read FSQLType;
397		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
398		property Handle: TISC_STMT_HANDLE read FHandle;
336	–	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
399		property UniqueRelationName: String read GetUniqueRelationName;
400		published
401		property Database: TIBDatabase read GetDatabase write SetDatabase;
402	+	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
403	+	property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
404		property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
405		write FGoToFirstRecordOnExecute
406		default True;
#	Line 349 | Line 413 | type
413		implementation
414
415		uses
416	<	IBIntf, IBBlob, Variants {$IFDEF HAS_SQLMONITOR}, IBSQLMonitor {$ENDIF};
416	>	IBIntf, IBBlob, Variants , IBSQLMonitor;
417
418		{ TIBXSQLVAR }
419		constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
#	Line 364 | Line 428 | var
428		szBuff: PChar;
429		s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
430		bSourceBlob, bDestBlob: Boolean;
431	<	iSegs, iMaxSeg, iSize: Long;
431	>	iSegs: Int64;
432	>	iMaxSeg: Int64;
433	>	iSize: Int64;
434		iBlobType: Short;
435		begin
436		szBuff := nil;
#	Line 426 | Line 492 | begin
492		0, nil), True);
493		try
494		IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
495	+	isNull := false
496		finally
497		FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
498		end;
#	Line 584 | Line 651 | end;
651		function TIBXSQLVAR.GetAsDateTime: TDateTime;
652		var
653		tm_date: TCTimeStructure;
654	+	msecs: word;
655		begin
656		result := 0;
657		if not IsNull then
#	Line 609 | Line 677 | begin
677		SQL_TYPE_TIME: begin
678		isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
679		try
680	+	msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
681		result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
682	<	Word(tm_date.tm_sec), 0)
682	>	Word(tm_date.tm_sec), msecs)
683		except
684		on E: EConvertError do begin
685		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 622 | Line 691 | begin
691		try
692		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
693		Word(tm_date.tm_mday));
694	+	msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
695		if result >= 0 then
696		result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
697	<	Word(tm_date.tm_sec), 0)
697	>	Word(tm_date.tm_sec), msecs)
698		else
699		result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
700	<	Word(tm_date.tm_sec), 0)
700	>	Word(tm_date.tm_sec), msecs)
701		except
702		on E: EConvertError do begin
703		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 757 | Line 827 | begin
827		result := '(Array)'; {do not localize}
828		SQL_BLOB: begin
829		ss := TStringStream.Create('');
830	<	SaveToStream(ss);
831	<	result := ss.DataString;
832	<	ss.Free;
830	>	try
831	>	SaveToStream(ss);
832	>	result := ss.DataString;
833	>	finally
834	>	ss.Free;
835	>	end;
836		end;
837		SQL_TEXT, SQL_VARYING: begin
838		sz := FXSQLVAR^.sqldata;
#	Line 826 | Line 899 | begin
899		result := AsDouble;
900		SQL_INT64:
901		if FXSQLVAR^.sqlscale = 0 then
902	<	IBError(ibxeInvalidDataConversion, [nil])
902	>	result := AsInt64
903		else if FXSQLVAR^.sqlscale >= (-4) then
904		result := AsCurrency
905		else
#	Line 921 | Line 994 | begin
994		result := FXSQLVAR^.sqltype and (not 1);
995		end;
996
997	+	procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
998	+	begin
999	+	if IsNullable then
1000	+	IsNull := False;
1001	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1002	+	FXSQLVAR^.sqlscale := -4;
1003	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1004	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1005	+	PCurrency(FXSQLVAR^.sqldata)^ := Value;
1006	+	FModified := True;
1007	+	end;
1008	+
1009		procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1010		var
926	–	xvar: TIBXSQLVAR;
1011		i: Integer;
1012		begin
1013		if FSQL.Database.SQLDialect < 3 then
1014		AsDouble := Value
1015		else
1016		begin
1017	<	if IsNullable then
1018	<	IsNull := False;
1017	>
1018	>	if FUniqueName then
1019	>	xSetAsCurrency(Value)
1020	>	else
1021		for i := 0 to FParent.FCount - 1 do
1022	<	if FParent.FNames[i] = FName then
1023	<	begin
938	<	xvar := FParent[i];
939	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
940	<	xvar.FXSQLVAR^.sqlscale := -4;
941	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
942	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
943	<	PCurrency(xvar.FXSQLVAR^.sqldata)^ := Value;
944	<	xvar.FModified := True;
945	<	end;
1022	>	if FParent[i].FName = FName then
1023	>	FParent[i].xSetAsCurrency(Value);
1024		end;
1025		end;
1026
1027	+	procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1028	+	begin
1029	+	if IsNullable then
1030	+	IsNull := False;
1031	+
1032	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1033	+	FXSQLVAR^.sqlscale := 0;
1034	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1035	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1036	+	PInt64(FXSQLVAR^.sqldata)^ := Value;
1037	+	FModified := True;
1038	+	end;
1039	+
1040		procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1041		var
1042		i: Integer;
1043	<	xvar: TIBXSQLVAR;
1043	>	begin
1044	>	if FUniqueName then
1045	>	xSetAsInt64(Value)
1046	>	else
1047	>	for i := 0 to FParent.FCount - 1 do
1048	>	if FParent[i].FName = FName then
1049	>	FParent[i].xSetAsInt64(Value);
1050	>	end;
1051	>
1052	>	procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1053	>	var
1054	>	tm_date: TCTimeStructure;
1055	>	Yr, Mn, Dy: Word;
1056		begin
1057		if IsNullable then
1058		IsNull := False;
1059	<	for i := 0 to FParent.FCount - 1 do
1060	<	if FParent.FNames[i] = FName then
1061	<	begin
1062	<	xvar := FParent[i];
1063	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1064	<	xvar.FXSQLVAR^.sqlscale := 0;
1065	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1066	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1067	<	PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1068	<	xvar.FModified := True;
1069	<	end;
1059	>
1060	>	FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1061	>	DecodeDate(Value, Yr, Mn, Dy);
1062	>	with tm_date do begin
1063	>	tm_sec := 0;
1064	>	tm_min := 0;
1065	>	tm_hour := 0;
1066	>	tm_mday := Dy;
1067	>	tm_mon := Mn - 1;
1068	>	tm_year := Yr - 1900;
1069	>	end;
1070	>	FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1071	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1072	>	isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1073	>	FModified := True;
1074		end;
1075
1076		procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1077		var
1078		i: Integer;
972	–	tm_date: TCTimeStructure;
973	–	Yr, Mn, Dy: Word;
974	–	xvar: TIBXSQLVAR;
1079		begin
1080		if FSQL.Database.SQLDialect < 3 then
1081		begin
1082		AsDateTime := Value;
1083		exit;
1084		end;
1085	+
1086	+	if FUniqueName then
1087	+	xSetAsDate(Value)
1088	+	else
1089	+	for i := 0 to FParent.FCount - 1 do
1090	+	if FParent[i].FName = FName then
1091	+	FParent[i].xSetAsDate(Value);
1092	+	end;
1093	+
1094	+	procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1095	+	var
1096	+	tm_date: TCTimeStructure;
1097	+	Hr, Mt, S, Ms: Word;
1098	+	begin
1099		if IsNullable then
1100		IsNull := False;
1101	<	for i := 0 to FParent.FCount - 1 do
1102	<	if FParent.FNames[i] = FName then
1103	<	begin
1104	<	xvar := FParent[i];
1105	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1106	<	DecodeDate(Value, Yr, Mn, Dy);
1107	<	with tm_date do begin
1108	<	tm_sec := 0;
1109	<	tm_min := 0;
1110	<	tm_hour := 0;
1111	<	tm_mday := Dy;
1112	<	tm_mon := Mn - 1;
1113	<	tm_year := Yr - 1900;
1114	<	end;
1115	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1116	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1117	<	isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
1000	<	xvar.FModified := True;
1001	<	end;
1101	>
1102	>	FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1103	>	DecodeTime(Value, Hr, Mt, S, Ms);
1104	>	with tm_date do begin
1105	>	tm_sec := S;
1106	>	tm_min := Mt;
1107	>	tm_hour := Hr;
1108	>	tm_mday := 0;
1109	>	tm_mon := 0;
1110	>	tm_year := 0;
1111	>	end;
1112	>	FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1113	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1114	>	isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1115	>	if Ms > 0 then
1116	>	Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1117	>	FModified := True;
1118		end;
1119
1120		procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1121		var
1122		i: Integer;
1007	–	tm_date: TCTimeStructure;
1008	–	Hr, Mt, S, Ms: Word;
1009	–	xvar: TIBXSQLVAR;
1123		begin
1124		if FSQL.Database.SQLDialect < 3 then
1125		begin
1126		AsDateTime := Value;
1127		exit;
1128		end;
1129	<	if IsNullable then
1130	<	IsNull := False;
1129	>
1130	>	if FUniqueName then
1131	>	xSetAsTime(Value)
1132	>	else
1133		for i := 0 to FParent.FCount - 1 do
1134	<	if FParent.FNames[i] = FName then
1135	<	begin
1021	<	xvar := FParent[i];
1022	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR^.sqltype and 1);
1023	<	DecodeTime(Value, Hr, Mt, S, Ms);
1024	<	with tm_date do begin
1025	<	tm_sec := S;
1026	<	tm_min := Mt;
1027	<	tm_hour := Hr;
1028	<	tm_mday := 0;
1029	<	tm_mon := 0;
1030	<	tm_year := 0;
1031	<	end;
1032	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1033	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1034	<	isc_encode_sql_time(@tm_date, PISC_TIME(xvar.FXSQLVAR^.sqldata));
1035	<	xvar.FModified := True;
1036	<	end;
1134	>	if FParent[i].FName = FName then
1135	>	FParent[i].xSetAsTime(Value);
1136		end;
1137
1138	<	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1138	>	procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1139		var
1041	–	i: Integer;
1140		tm_date: TCTimeStructure;
1141		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1044	–	xvar: TIBXSQLVAR;
1142		begin
1143		if IsNullable then
1144		IsNull := False;
1145	+
1146	+	FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1147	+	DecodeDate(Value, Yr, Mn, Dy);
1148	+	DecodeTime(Value, Hr, Mt, S, Ms);
1149	+	with tm_date do begin
1150	+	tm_sec := S;
1151	+	tm_min := Mt;
1152	+	tm_hour := Hr;
1153	+	tm_mday := Dy;
1154	+	tm_mon := Mn - 1;
1155	+	tm_year := Yr - 1900;
1156	+	end;
1157	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1158	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1159	+	isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1160	+	if Ms > 0 then
1161	+	Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1162	+	FModified := True;
1163	+	end;
1164	+
1165	+	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1166	+	var
1167	+	i: Integer;
1168	+	begin
1169	+	if FUniqueName then
1170	+	xSetAsDateTime(value)
1171	+	else
1172		for i := 0 to FParent.FCount - 1 do
1173	<	if FParent.FNames[i] = FName then
1174	<	begin
1175	<	xvar := FParent[i];
1176	<	xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1177	<	DecodeDate(Value, Yr, Mn, Dy);
1178	<	DecodeTime(Value, Hr, Mt, S, Ms);
1179	<	with tm_date do begin
1180	<	tm_sec := S;
1181	<	tm_min := Mt;
1182	<	tm_hour := Hr;
1183	<	tm_mday := Dy;
1184	<	tm_mon := Mn - 1;
1185	<	tm_year := Yr - 1900;
1186	<	end;
1187	<	xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1064	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1065	<	isc_encode_date(@tm_date, PISC_QUAD(xvar.FXSQLVAR^.sqldata));
1066	<	xvar.FModified := True;
1067	<	end;
1173	>	if FParent[i].FName = FName then
1174	>	FParent[i].xSetAsDateTime(Value);
1175	>	end;
1176	>
1177	>	procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1178	>	begin
1179	>	if IsNullable then
1180	>	IsNull := False;
1181	>
1182	>	FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1183	>	FXSQLVAR^.sqllen := SizeOf(Double);
1184	>	FXSQLVAR^.sqlscale := 0;
1185	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1186	>	PDouble(FXSQLVAR^.sqldata)^ := Value;
1187	>	FModified := True;
1188		end;
1189
1190		procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1191		var
1192		i: Integer;
1193	<	xvar: TIBXSQLVAR;
1193	>	begin
1194	>	if FUniqueName then
1195	>	xSetAsDouble(Value)
1196	>	else
1197	>	for i := 0 to FParent.FCount - 1 do
1198	>	if FParent[i].FName = FName then
1199	>	FParent[i].xSetAsDouble(Value);
1200	>	end;
1201	>
1202	>	procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1203		begin
1204		if IsNullable then
1205		IsNull := False;
1206	<	for i := 0 to FParent.FCount - 1 do
1207	<	if FParent.FNames[i] = FName then
1208	<	begin
1209	<	xvar := FParent[i];
1210	<	xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1211	<	xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1212	<	xvar.FXSQLVAR^.sqlscale := 0;
1084	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1085	<	PDouble(xvar.FXSQLVAR^.sqldata)^ := Value;
1086	<	xvar.FModified := True;
1087	<	end;
1206	>
1207	>	FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1208	>	FXSQLVAR^.sqllen := SizeOf(Float);
1209	>	FXSQLVAR^.sqlscale := 0;
1210	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1211	>	PSingle(FXSQLVAR^.sqldata)^ := Value;
1212	>	FModified := True;
1213		end;
1214
1215		procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1216		var
1217		i: Integer;
1218	<	xvar: TIBXSQLVAR;
1218	>	begin
1219	>	if FUniqueName then
1220	>	xSetAsFloat(Value)
1221	>	else
1222	>	for i := 0 to FParent.FCount - 1 do
1223	>	if FParent[i].FName = FName then
1224	>	FParent[i].xSetAsFloat(Value);
1225	>	end;
1226	>
1227	>	procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1228		begin
1229		if IsNullable then
1230		IsNull := False;
1231	<	for i := 0 to FParent.FCount - 1 do
1232	<	if FParent.FNames[i] = FName then
1233	<	begin
1234	<	xvar := FParent[i];
1235	<	xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1236	<	xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1237	<	xvar.FXSQLVAR^.sqlscale := 0;
1104	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1105	<	PSingle(xvar.FXSQLVAR^.sqldata)^ := Value;
1106	<	xvar.FModified := True;
1107	<	end;
1231	>
1232	>	FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1233	>	FXSQLVAR^.sqllen := SizeOf(Long);
1234	>	FXSQLVAR^.sqlscale := 0;
1235	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1236	>	PLong(FXSQLVAR^.sqldata)^ := Value;
1237	>	FModified := True;
1238		end;
1239
1240		procedure TIBXSQLVAR.SetAsLong(Value: Long);
1241		var
1242		i: Integer;
1113	–	xvar: TIBXSQLVAR;
1243		begin
1244	<	if IsNullable then
1245	<	IsNull := False;
1244	>	if FUniqueName then
1245	>	xSetAsLong(Value)
1246	>	else
1247		for i := 0 to FParent.FCount - 1 do
1248	<	if FParent.FNames[i] = FName then
1249	<	begin
1120	<	xvar := FParent[i];
1121	<	xvar.FXSQLVAR^.sqltype := SQL_LONG or (xvar.FXSQLVAR^.sqltype and 1);
1122	<	xvar.FXSQLVAR^.sqllen := SizeOf(Long);
1123	<	xvar.FXSQLVAR^.sqlscale := 0;
1124	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1125	<	PLong(xvar.FXSQLVAR^.sqldata)^ := Value;
1126	<	xvar.FModified := True;
1127	<	end;
1248	>	if FParent[i].FName = FName then
1249	>	FParent[i].xSetAsLong(Value);
1250		end;
1251
1252	<	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1131	<	var
1132	<	i: Integer;
1133	<	xvar: TIBXSQLVAR;
1252	>	procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1253		begin
1254		if IsNullable and (Value = nil) then
1255		IsNull := True
1256		else begin
1257		IsNull := False;
1258	<	for i := 0 to FParent.FCount - 1 do
1259	<	if FParent.FNames[i] = FName then
1141	<	begin
1142	<	xvar := FParent[i];
1143	<	xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1144	<	Move(Value^, xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1145	<	xvar.FModified := True;
1146	<	end;
1258	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1259	>	Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1260		end;
1261	+	FModified := True;
1262	+	end;
1263	+
1264	+	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1265	+	var
1266	+	i: Integer;
1267	+	begin
1268	+	if FUniqueName then
1269	+	xSetAsPointer(Value)
1270	+	else
1271	+	for i := 0 to FParent.FCount - 1 do
1272	+	if FParent[i].FName = FName then
1273	+	FParent[i].xSetAsPointer(Value);
1274	+	end;
1275	+
1276	+	procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1277	+	begin
1278	+	if IsNullable then
1279	+	IsNull := False;
1280	+	if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1281	+	(FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1282	+	IBError(ibxeInvalidDataConversion, [nil]);
1283	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1284	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1285	+	PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1286	+	FModified := True;
1287		end;
1288
1289		procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1290		var
1291		i: Integer;
1292	<	xvar: TIBXSQLVAR;
1292	>	begin
1293	>	if FUniqueName then
1294	>	xSetAsQuad(Value)
1295	>	else
1296	>	for i := 0 to FParent.FCount - 1 do
1297	>	if FParent[i].FName = FName then
1298	>	FParent[i].xSetAsQuad(Value);
1299	>	end;
1300	>
1301	>	procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1302		begin
1303		if IsNullable then
1304		IsNull := False;
1305	<	for i := 0 to FParent.FCount - 1 do
1306	<	if FParent.FNames[i] = FName then
1307	<	begin
1308	<	xvar := FParent[i];
1309	<	if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1310	<	(xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1311	<	IBError(ibxeInvalidDataConversion, [nil]);
1164	<	xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1165	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1166	<	PISC_QUAD(xvar.FXSQLVAR^.sqldata)^ := Value;
1167	<	xvar.FModified := True;
1168	<	end;
1305	>
1306	>	FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1307	>	FXSQLVAR^.sqllen := SizeOf(Short);
1308	>	FXSQLVAR^.sqlscale := 0;
1309	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1310	>	PShort(FXSQLVAR^.sqldata)^ := Value;
1311	>	FModified := True;
1312		end;
1313
1314		procedure TIBXSQLVAR.SetAsShort(Value: Short);
1315		var
1316		i: Integer;
1174	–	xvar: TIBXSQLVAR;
1317		begin
1318	<	if IsNullable then
1319	<	IsNull := False;
1318	>	if FUniqueName then
1319	>	xSetAsShort(Value)
1320	>	else
1321		for i := 0 to FParent.FCount - 1 do
1322	<	if FParent.FNames[i] = FName then
1323	<	begin
1181	<	xvar := FParent[i];
1182	<	xvar.FXSQLVAR^.sqltype := SQL_SHORT or (xvar.FXSQLVAR^.sqltype and 1);
1183	<	xvar.FXSQLVAR^.sqllen := SizeOf(Short);
1184	<	xvar.FXSQLVAR^.sqlscale := 0;
1185	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1186	<	PShort(xvar.FXSQLVAR^.sqldata)^ := Value;
1187	<	xvar.FModified := True;
1188	<	end;
1322	>	if FParent[i].FName = FName then
1323	>	FParent[i].xSetAsShort(Value);
1324		end;
1325
1326	<	procedure TIBXSQLVAR.SetAsString(Value: String);
1326	>	procedure TIBXSQLVAR.xSetAsString(Value: String);
1327		var
1328	<	stype: Integer;
1329	<	ss: TStringStream;
1328	>	stype: Integer;
1329	>	ss: TStringStream;
1330
1331	<	procedure SetStringValue;
1332	<	var
1333	<	i: Integer;
1334	<	xvar: TIBXSQLVAR;
1335	<	begin
1336	<	for i := 0 to FParent.FCount - 1 do
1337	<	if FParent.FNames[i] = FName then
1338	<	begin
1339	<	xvar := FParent[i];
1340	<	if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1341	<	(xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1342	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1343	<	else begin
1209	<	xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1210	<	xvar.FXSQLVAR^.sqllen := Length(Value);
1211	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen + 1);
1212	<	if (Length(Value) > 0) then
1213	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1214	<	end;
1215	<	xvar.FModified := True;
1331	>	procedure SetStringValue;
1332	>	var
1333	>	i: Integer;
1334	>	begin
1335	>	if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1336	>	(FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1337	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1338	>	else begin
1339	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1340	>	FXSQLVAR^.sqllen := Length(Value);
1341	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1342	>	if (Length(Value) > 0) then
1343	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1344		end;
1345	<	end;
1345	>	FModified := True;
1346	>	end;
1347
1348		begin
1349		if IsNullable then
1350		IsNull := False;
1351	+
1352		stype := FXSQLVAR^.sqltype and (not 1);
1353		if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1354		SetStringValue
#	Line 1236 | Line 1366 | begin
1366		IsNull := True
1367		else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1368		(stype = SQL_TYPE_TIME) then
1369	<	SetAsDateTime(StrToDateTime(Value))
1369	>	xSetAsDateTime(StrToDateTime(Value))
1370		else
1371		SetStringValue;
1372		end;
1373		end;
1374
1375	<	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1375	>	procedure TIBXSQLVAR.SetAsString(Value: String);
1376	>	var
1377	>	i: integer;
1378	>	begin
1379	>	if FUniqueName then
1380	>	xSetAsString(Value)
1381	>	else
1382	>	for i := 0 to FParent.FCount - 1 do
1383	>	if FParent[i].FName = FName then
1384	>	FParent[i].xSetAsString(Value);
1385	>	end;
1386	>
1387	>	procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1388		begin
1389		if VarIsNull(Value) then
1390		IsNull := True
1391		else case VarType(Value) of
1392		varEmpty, varNull:
1393		IsNull := True;
1394	<	varSmallint, varInteger, varByte:
1394	>	varSmallint, varInteger, varByte,
1395	>	varWord, varShortInt:
1396		AsLong := Value;
1397	+	varInt64:
1398	+	AsInt64 := Value;
1399		varSingle, varDouble:
1400		AsDouble := Value;
1401		varCurrency:
#	Line 1271 | Line 1416 | begin
1416		end;
1417		end;
1418
1419	<	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1419	>	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1420	>	var
1421	>	i: integer;
1422	>	begin
1423	>	if FUniqueName then
1424	>	xSetAsVariant(Value)
1425	>	else
1426	>	for i := 0 to FParent.FCount - 1 do
1427	>	if FParent[i].FName = FName then
1428	>	FParent[i].xSetAsVariant(Value);
1429	>	end;
1430	>
1431	>	procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1432		var
1276	–	i: Integer;
1277	–	xvar: TIBXSQLVAR;
1433		sqlind: PShort;
1434		sqldata: PChar;
1435		local_sqllen: Integer;
1436		begin
1437	<	for i := 0 to FParent.FCount - 1 do
1438	<	if FParent.FNames[i] = FName then
1439	<	begin
1440	<	xvar := FParent[i];
1441	<	sqlind := xvar.FXSQLVAR^.sqlind;
1442	<	sqldata := xvar.FXSQLVAR^.sqldata;
1443	<	Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1444	<	xvar.FXSQLVAR^.sqlind := sqlind;
1445	<	xvar.FXSQLVAR^.sqldata := sqldata;
1446	<	if (Value^.sqltype and 1 = 1) then
1447	<	begin
1448	<	if (xvar.FXSQLVAR^.sqlind = nil) then
1449	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1450	<	xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1451	<	end
1452	<	else
1453	<	if (xvar.FXSQLVAR^.sqlind <> nil) then
1454	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1455	<	if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1456	<	local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1457	<	else
1458	<	local_sqllen := xvar.FXSQLVAR^.sqllen;
1304	<	FXSQLVAR^.sqlscale := Value^.sqlscale;
1305	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen);
1306	<	Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen);
1307	<	xvar.FModified := True;
1308	<	end;
1437	>	sqlind := FXSQLVAR^.sqlind;
1438	>	sqldata := FXSQLVAR^.sqldata;
1439	>	Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1440	>	FXSQLVAR^.sqlind := sqlind;
1441	>	FXSQLVAR^.sqldata := sqldata;
1442	>	if (Value^.sqltype and 1 = 1) then
1443	>	begin
1444	>	if (FXSQLVAR^.sqlind = nil) then
1445	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1446	>	FXSQLVAR^.sqlind^ := Value^.sqlind^;
1447	>	end
1448	>	else
1449	>	if (FXSQLVAR^.sqlind <> nil) then
1450	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1451	>	if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1452	>	local_sqllen := FXSQLVAR^.sqllen + 2
1453	>	else
1454	>	local_sqllen := FXSQLVAR^.sqllen;
1455	>	FXSQLVAR^.sqlscale := Value^.sqlscale;
1456	>	IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1457	>	Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1458	>	FModified := True;
1459		end;
1460
1461	<	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1461	>	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1462		var
1463		i: Integer;
1464	<	xvar: TIBXSQLVAR;
1464	>	begin
1465	>	if FUniqueName then
1466	>	xSetAsXSQLVAR(Value)
1467	>	else
1468	>	for i := 0 to FParent.FCount - 1 do
1469	>	if FParent[i].FName = FName then
1470	>	FParent[i].xSetAsXSQLVAR(Value);
1471	>	end;
1472	>
1473	>	procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1474		begin
1475		if Value then
1476		begin
1477		if not IsNullable then
1478		IsNullable := True;
1479	<	for i := 0 to FParent.FCount - 1 do
1480	<	if FParent.FNames[i] = FName then
1481	<	begin
1482	<	xvar := FParent[i];
1324	<	if Assigned(xvar.FXSQLVAR^.sqlind) then
1325	<	xvar.FXSQLVAR^.sqlind^ := -1;
1326	<	xvar.FModified := True;
1327	<	end;
1479	>
1480	>	if Assigned(FXSQLVAR^.sqlind) then
1481	>	FXSQLVAR^.sqlind^ := -1;
1482	>	FModified := True;
1483		end
1484		else
1485		if ((not Value) and IsNullable) then
1486		begin
1487	<	for i := 0 to FParent.FCount - 1 do
1488	<	if FParent.FNames[i] = FName then
1489	<	begin
1335	<	xvar := FParent[i];
1336	<	if Assigned(xvar.FXSQLVAR^.sqlind) then
1337	<	xvar.FXSQLVAR^.sqlind^ := 0;
1338	<	xvar.FModified := True;
1339	<	end;
1487	>	if Assigned(FXSQLVAR^.sqlind) then
1488	>	FXSQLVAR^.sqlind^ := 0;
1489	>	FModified := True;
1490		end;
1491		end;
1492
1493	<	procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1493	>	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1494		var
1495		i: Integer;
1346	–	xvar: TIBXSQLVAR;
1496		begin
1497	+	if FUniqueName then
1498	+	xSetIsNull(Value)
1499	+	else
1500		for i := 0 to FParent.FCount - 1 do
1501	<	if FParent.FNames[i] = FName then
1501	>	if FParent[i].FName = FName then
1502	>	FParent[i].xSetIsNull(Value);
1503	>	end;
1504	>
1505	>	procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1506	>	begin
1507	>	if (Value <> IsNullable) then
1508	>	begin
1509	>	if Value then
1510		begin
1511	<	xvar := FParent[i];
1512	<	if (Value <> IsNullable) then
1513	<	begin
1514	<	if Value then
1515	<	begin
1516	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1517	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1358	<	end
1359	<	else
1360	<	begin
1361	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1362	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1363	<	end;
1364	<	end;
1511	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1512	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1513	>	end
1514	>	else
1515	>	begin
1516	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1517	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1518		end;
1519	+	end;
1520		end;
1521
1522	+	procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1523	+	var
1524	+	i: Integer;
1525	+	begin
1526	+	if FUniqueName then
1527	+	xSetIsNullable(Value)
1528	+	else
1529	+	for i := 0 to FParent.FCount - 1 do
1530	+	if FParent[i].FName = FName then
1531	+	FParent[i].xSetIsNullable(Value);
1532	+	end;
1533	+
1534	+	procedure TIBXSQLVAR.Clear;
1535	+	begin
1536	+	IsNull := true;
1537	+	end;
1538	+
1539	+
1540		{ TIBXSQLDA }
1541	<	constructor TIBXSQLDA.Create(Query: TIBSQL);
1541	>	constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1542		begin
1543		inherited Create;
1544		FSQL := Query;
1373	–	FNames := TStringList.Create;
1545		FSize := 0;
1546		FUniqueRelationName := '';
1547	+	FInputSQLDA := sqldaType = daInput;
1548		end;
1549
1550		destructor TIBXSQLDA.Destroy;
1551		var
1552		i: Integer;
1553		begin
1382	–	FNames.Free;
1554		if FXSQLDA <> nil then
1555		begin
1556		for i := 0 to FSize - 1 do
#	Line 1395 | Line 1566 | begin
1566		inherited Destroy;
1567		end;
1568
1569	<	procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1569	>	procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1570	>	UniqueName: boolean);
1571		var
1572	<	fn: String;
1572	>	fn: string;
1573		begin
1574	<	fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1575	<	while FNames.Count <= Idx do
1576	<	FNames.Add('');
1577	<	FNames[Idx] := fn;
1578	<	FXSQLVARs[Idx].FName := fn;
1574	>	{$ifdef UseCaseSensitiveParamName}
1575	>	FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1576	>	{$else}
1577	>	FXSQLVARs[Idx].FName := FieldName;
1578	>	{$endif}
1579		FXSQLVARs[Idx].FIndex := Idx;
1580	+	FXSQLVARs[Idx].FUniqueName :=  UniqueName
1581		end;
1582
1583		function TIBXSQLDA.GetModified: Boolean;
#	Line 1420 | Line 1593 | begin
1593		end;
1594		end;
1595
1423	–	function TIBXSQLDA.GetNames: String;
1424	–	begin
1425	–	result := FNames.Text;
1426	–	end;
1427	–
1596		function TIBXSQLDA.GetRecordSize: Integer;
1597		begin
1598		result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
#	Line 1452 | Line 1620 | end;
1620		function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1621		var
1622		s: String;
1623	<	i, Cnt: Integer;
1623	>	i: Integer;
1624		begin
1625	<	s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1626	<	i := 0;
1627	<	Cnt := FNames.Count;
1628	<	while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1629	<	if i = Cnt then
1630	<	result := nil
1631	<	else
1632	<	result := GetXSQLVAR(i);
1625	>	{$ifdef ALLOWDIALECT3PARAMNAMES}
1626	>	s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1627	>	{$else}
1628	>	{$ifdef UseCaseSensitiveParamName}
1629	>	s := AnsiUpperCase(Idx);
1630	>	{$else}
1631	>	s := Idx;
1632	>	{$endif}
1633	>	{$endif}
1634	>	for i := 0 to FCount - 1 do
1635	>	if Vars[i].FName = s then
1636	>	begin
1637	>	Result := FXSQLVARs[i];
1638	>	Exit;
1639	>	end;
1640	>	Result := nil;
1641		end;
1642
1643		procedure TIBXSQLDA.Initialize;
1644	+
1645	+	function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1646	+	var
1647	+	k: integer;
1648	+	begin
1649	+	for k := 0 to limit do
1650	+	if FXSQLVARs[k].FName = idx then
1651	+	begin
1652	+	Result := FXSQLVARs[k];
1653	+	Exit;
1654	+	end;
1655	+	Result := nil;
1656	+	end;
1657	+
1658		var
1659		i, j, j_len: Integer;
1470	–	NamesWereEmpty: Boolean;
1660		st: String;
1661		bUnique: Boolean;
1662	+	sBaseName: string;
1663		begin
1664		bUnique := True;
1475	–	NamesWereEmpty := (FNames.Count = 0);
1665		if FXSQLDA <> nil then
1666		begin
1667		for i := 0 to FCount - 1 do
1668		begin
1669		with FXSQLVARs[i].Data^ do
1670		begin
1671	+
1672	+	{First get the unique relation name, if any}
1673	+
1674		if bUnique and (strpas(relname) <> '') then
1675		begin
1676		if FUniqueRelationName = '' then
#	Line 1490 | Line 1682 | begin
1682		bUnique := False;
1683		end;
1684		end;
1685	<	if NamesWereEmpty then
1685	>
1686	>	{If an output SQLDA then copy the aliasnames to the FName list. Ensure
1687	>	that they are all upper case only and disambiguated.
1688	>	}
1689	>
1690	>	if not FInputSQLDA then
1691		begin
1692	<	st := strpas(aliasname);
1692	>	st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1693		if st = '' then
1694		begin
1695	<	st := 'F_'; {do not localize}
1695	>	sBaseName := 'F_'; {do not localize}
1696		aliasname_length := 2;
1697		j := 1; j_len := 1;
1698	<	StrPCopy(aliasname, st + IntToStr(j));
1698	>	st := sBaseName + IntToStr(j);
1699		end
1700		else
1701		begin
1505	–	StrPCopy(aliasname, st);
1702		j := 0; j_len := 0;
1703	+	sBaseName := st;
1704		end;
1705	<	while GetXSQLVARByName(strpas(aliasname)) <> nil do
1705	>
1706	>	{Look for other columns with the same name and make unique}
1707	>
1708	>	while VarByName(st,i-1) <> nil do
1709		begin
1710	<	Inc(j); j_len := Length(IntToStr(j));
1711	<	if j_len + aliasname_length > 31 then
1712	<	StrPCopy(aliasname,
1713	<	Copy(st, 1, 31 - j_len) +
1714	<	IntToStr(j))
1715	<	else
1516	<	StrPCopy(aliasname, st + IntToStr(j));
1710	>	Inc(j);
1711	>	j_len := Length(IntToStr(j));
1712	>	if j_len + Length(sBaseName) > 31 then
1713	>	st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1714	>	else
1715	>	st := sBaseName + IntToStr(j);
1716		end;
1717	<	Inc(aliasname_length, j_len);
1718	<	AddName(strpas(aliasname), i);
1717	>
1718	>	FXSQLVARs[i].FName := st;
1719		end;
1720	+
1721	+	{Finally initialise the XSQLVAR}
1722	+
1723	+	FXSQLVARs[i].FIndex := i;
1724	+
1725		case sqltype and (not 1) of
1726		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1727		SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
#	Line 1550 | Line 1754 | var
1754		i, OldSize: Integer;
1755		p : PXSQLVAR;
1756		begin
1553	–	FNames.Clear;
1757		FCount := Value;
1758		if FCount = 0 then
1759		FUniqueRelationName := ''
#	Line 1587 | Line 1790 | end;
1790
1791		destructor TIBOutputDelimitedFile.Destroy;
1792		begin
1793	<	{$IFDEF LINUX}
1793	>	{$IFDEF UNIX}
1794		if FHandle <> -1 then
1795		fpclose(FHandle);
1796		{$ELSE}
#	Line 1603 | Line 1806 | end;
1806		procedure TIBOutputDelimitedFile.ReadyFile;
1807		var
1808		i: Integer;
1809	<	{$IFDEF LINUX}
1809	>	{$IFDEF UNIX}
1810		BytesWritten: cint;
1811		{$ELSE}
1812		BytesWritten: DWORD;
#	Line 1614 | Line 1817 | begin
1817		FColDelimiter := TAB;
1818		if FRowDelimiter = '' then
1819		FRowDelimiter := CRLF;
1820	<	{$IFDEF LINUX}
1820	>	{$IFDEF UNIX}
1821		FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1822		{$ELSE}
1823		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
#	Line 1630 | Line 1833 | begin
1833		else
1834		st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1835		st := st + FRowDelimiter;
1836	<	{$IFDEF LINUX}
1836	>	{$IFDEF UNIX}
1837		if FHandle <> -1 then
1838		BytesWritten := FpWrite(FHandle,st[1],Length(st));
1839		if BytesWritten = -1 then
1840		raise Exception.Create('File Write Error');
1841		{$ELSE}
1842	<	WriteFile(FHandle, PChar(st[1]), Length(st), BytesWritten, nil);
1842	>	WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1843		{$ENDIF}
1844		end;
1845		end;
#	Line 1644 | Line 1847 | end;
1847		function TIBOutputDelimitedFile.WriteColumns: Boolean;
1848		var
1849		i: Integer;
1850	<	{$IFDEF LINUX}
1850	>	{$IFDEF UNIX}
1851		BytesWritten: cint;
1852		{$ELSE}
1853		BytesWritten: DWORD;
#	Line 1652 | Line 1855 | var
1855		st: string;
1856		begin
1857		result := False;
1858	<	{$IFDEF LINUX}
1858	>	{$IFDEF UNIX}
1859		if FHandle <> -1 then
1860		{$ELSE}
1861		if FHandle <> 0 then
#	Line 1666 | Line 1869 | begin
1869		st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1870		end;
1871		st := st + FRowDelimiter;
1872	<	{$IFDEF LINUX}
1872	>	{$IFDEF UNIX}
1873		BytesWritten := FpWrite(FHandle,st[1],Length(st));
1874		{$ELSE}
1875		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
#	Line 1783 | Line 1986 | end;
1986		{ TIBOutputRawFile }
1987		destructor TIBOutputRawFile.Destroy;
1988		begin
1989	<	{$IFDEF LINUX}
1989	>	{$IFDEF UNIX}
1990		if FHandle <> -1 then
1991		fpclose(FHandle);
1992		{$ELSE}
#	Line 1798 | Line 2001 | end;
2001
2002		procedure TIBOutputRawFile.ReadyFile;
2003		begin
2004	<	{$IFDEF LINUX}
2004	>	{$IFDEF UNIX}
2005		FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
2006		{$ELSE}
2007		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
#	Line 1818 | Line 2021 | begin
2021		begin
2022		for i := 0 to Columns.Count - 1 do
2023		begin
2024	<	{$IFDEF LINUX}
2024	>	{$IFDEF UNIX}
2025		BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
2026		{$ELSE}
2027		WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
#	Line 1834 | Line 2037 | end;
2037		{ TIBInputRawFile }
2038		destructor TIBInputRawFile.Destroy;
2039		begin
2040	<	{$IFDEF LINUX}
2040	>	{$IFDEF UNIX}
2041		if FHandle <> -1 then
2042		fpclose(FHandle);
2043		{$ELSE}
#	Line 1850 | Line 2053 | var
2053		BytesRead: DWord;
2054		begin
2055		result := False;
2056	<	{$IFDEF LINUX}
2056	>	{$IFDEF UNIX}
2057		if FHandle <> -1 then
2058		{$ELSE}
2059		if FHandle <> 0 then
#	Line 1858 | Line 2061 | begin
2061		begin
2062		for i := 0 to Params.Count - 1 do
2063		begin
2064	<	{$IFDEF LINUX}
2064	>	{$IFDEF UNIX}
2065		BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
2066		{$ELSE}
2067	<	ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen);
2067	>	ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
2068		BytesRead, nil);
2069		{$ENDIF}
2070		if BytesRead <> DWORD(Params[i].Data^.sqllen) then
#	Line 1873 | Line 2076 | end;
2076
2077		procedure TIBInputRawFile.ReadyFile;
2078		begin
2079	<	{$IFDEF LINUX}
2079	>	{$IFDEF UNIX}
2080		if FHandle <> -1 then
2081		fpclose(FHandle);
2082		FHandle := FpOpen(Filename,O_RdOnly);
#	Line 1909 | Line 2112 | begin
2112		TStringList(FSQL).OnChanging := SQLChanging;
2113		FProcessedSQL := TStringList.Create;
2114		FHandle := nil;
2115	<	FSQLParams := TIBXSQLDA.Create(self);
2116	<	FSQLRecord := TIBXSQLDA.Create(self);
2115	>	FSQLParams := TIBXSQLDA.Create(self,daInput);
2116	>	FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2117		FSQLType := SQLUnknown;
2118		FParamCheck := True;
2119		FCursor := Name + RandomString(8);
#	Line 2023 | Line 2226 | begin
2226		result := FSQLRecord;
2227		end;
2228
2229	+	function TIBSQL.GetFieldCount: integer;
2230	+	begin
2231	+	Result := FSQLRecord.Count
2232	+	end;
2233	+
2234	+	procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2235	+	begin
2236	+	if FUniqueParamNames = AValue then Exit;
2237	+	FreeHandle;
2238	+	FUniqueParamNames := AValue;
2239	+	end;
2240	+
2241		procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2242		begin
2243		if (FHandle <> nil) then begin
#	Line 2062 | Line 2277 | begin
2277		@FHandle,
2278		Database.SQLDialect,
2279		FSQLParams.AsXSQLDA,
2280	<	FSQLRecord.AsXSQLDA), False);
2281	<	if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2280	>	FSQLRecord.AsXSQLDA), True);
2281	>	(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2282		begin
2283		{ Sometimes a prepared stored procedure appears to get
2284		off sync on the server ....This code is meant to try
#	Line 2078 | Line 2293 | begin
2293		Database.SQLDialect,
2294		FSQLParams.AsXSQLDA,
2295		FSQLRecord.AsXSQLDA), True);
2296	<	end;
2296	>	end;  *)
2297		end
2298		else
2299		Call(isc_dsql_execute(StatusVector,
#	Line 2087 | Line 2302 | begin
2302		Database.SQLDialect,
2303		FSQLParams.AsXSQLDA), True)
2304		end;
2090	–	{$IFDEF HAS_SQLMONITOR}
2305		if not (csDesigning in ComponentState) then
2306		MonitorHook.SQLExecute(Self);
2093	–	{$ENDIF}
2307		end;
2308
2309		function TIBSQL.GetEOF: Boolean;
#	Line 2152 | Line 2365 | begin
2365		FBOF := False;
2366		result := FSQLRecord;
2367		end;
2155	–	{$IFDEF HAS_SQLMONITOR}
2368		if not (csDesigning in ComponentState) then
2369		MonitorHook.SQLFetch(Self);
2158	–	{$ENDIF}
2370		end;
2371		end;
2372
#	Line 2222 | Line 2433 | begin
2433		result := FRecordCount;
2434		end;
2435
2436	<	function TIBSQL.GetRowsAffected: integer;
2436	>	function TIBSQL.GetRowsAffected: Integer;
2437		var
2438		result_buffer: array[0..1048] of Char;
2439		info_request: Char;
#	Line 2273 | Line 2484 | var
2484		cCurChar, cNextChar, cQuoteChar: Char;
2485		sSQL, sProcessedSQL, sParamName: String;
2486		i, iLenSQL, iSQLPos: Integer;
2487	<	iCurState, iCurParamState: Integer;
2487	>	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2488		iParamSuffix: Integer;
2489		slNames: TStrings;
2490
#	Line 2282 | Line 2493 | const
2493		CommentState = 1;
2494		QuoteState = 2;
2495		ParamState = 3;
2496	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2497		ParamDefaultState = 0;
2498		ParamQuoteState = 1;
2499	+	{$endif}
2500
2501		procedure AddToProcessedSQL(cChar: Char);
2502		begin
#	Line 2303 | Line 2516 | begin
2516		i := 1;
2517		iSQLPos := 1;
2518		iCurState := DefaultState;
2519	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2520		iCurParamState := ParamDefaultState;
2521	+	{$endif}
2522		{ Now, traverse through the SQL string, character by character,
2523		picking out the parameters and formatting correctly for InterBase }
2524		while (i <= iLenSQL) do begin
#	Line 2354 | Line 2569 | begin
2569		ParamState:
2570		begin
2571		{ collect the name of the parameter }
2572	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2573		if iCurParamState = ParamDefaultState then
2574		begin
2575		if cCurChar = '"' then
2576		iCurParamState := ParamQuoteState
2577	<	else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2577	>	else
2578	>	{$endif}
2579	>	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2580		sParamName := sParamName + cCurChar
2581		else if FGenerateParamNames then
2582		begin
2583		sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2584		Inc(iParamSuffix);
2585		iCurState := DefaultState;
2586	<	slNames.Add(sParamName);
2586	>	slNames.AddObject(sParamName,self); //Note local convention
2587	>	//add pointer to self to mark entry
2588		sParamName := '';
2589		end
2590		else
2591		IBError(ibxeSQLParseError, [SParamNameExpected]);
2592	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2593		end
2594		else begin
2595		{ determine if Quoted parameter name is finished }
#	Line 2384 | Line 2604 | begin
2604		else
2605		sParamName := sParamName + cCurChar
2606		end;
2607	+	{$endif}
2608		{ determine if the unquoted parameter name is finished }
2609	<	if (iCurParamState <> ParamQuoteState) and
2609	>	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2610		(iCurState <> DefaultState) then
2611		begin
2612		if not (cNextChar in ['A'..'Z', 'a'..'z',
#	Line 2405 | Line 2626 | begin
2626		AddToProcessedSQL(#0);
2627		FSQLParams.Count := slNames.Count;
2628		for i := 0 to slNames.Count - 1 do
2629	<	FSQLParams.AddName(slNames[i], i);
2629	>	FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2630		FProcessedSQL.Text := sProcessedSQL;
2631		finally
2632		slNames.Free;
#	Line 2486 | Line 2707 | begin
2707		end;
2708		end;
2709		FPrepared := True;
2489	–	{$IFDEF HAS_SQLMONITOR}
2710		if not (csDesigning in ComponentState) then
2711		MonitorHook.SQLPrepare(Self);
2492	–	{$ENDIF}
2712		except
2713		on E: Exception do begin
2714		if (FHandle <> nil) then
2715		FreeHandle;
2716	<	raise;
2716	>	if E is EIBInterBaseError then
2717	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2718	>	EIBInterBaseError(E).IBErrorCode,
2719	>	EIBInterBaseError(E).Message +
2720	>	sSQLErrorSeparator + FProcessedSQL.Text)
2721	>	else
2722	>	raise;
2723		end;
2724		end;
2725		end;

Diff Legend

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