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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 35 by tony, Tue Jan 26 14:38:47 2016 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	<	Windows, SysUtils, Classes, Forms, Controls, IBHeader,
74	>	{$IFDEF WINDOWS }
75	>	Windows,
76	>	{$ELSE}
77	>	baseunix, unix,
78	>	{$ENDIF}
79	>	SysUtils, Classes, 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 46 | 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;
101		function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
102		function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
103	+	function GetAsBoolean: boolean;
104		function GetAsCurrency: Currency;
105		function GetAsInt64: Int64;
106		function GetAsDateTime: TDateTime;
#	Line 67 | Line 117 | type
117		function GetIsNullable: Boolean;
118		function GetSize: Integer;
119		function GetSQLType: Integer;
120	+	procedure SetAsBoolean(AValue: boolean);
121		procedure SetAsCurrency(Value: Currency);
122		procedure SetAsInt64(Value: Int64);
123		procedure SetAsDate(Value: TDateTime);
124	+	procedure SetAsLong(Value: Long);
125		procedure SetAsTime(Value: TDateTime);
126		procedure SetAsDateTime(Value: TDateTime);
127		procedure SetAsDouble(Value: Double);
128		procedure SetAsFloat(Value: Float);
77	–	procedure SetAsLong(Value: Long);
129		procedure SetAsPointer(Value: Pointer);
130		procedure SetAsQuad(Value: TISC_QUAD);
131		procedure SetAsShort(Value: Short);
#	Line 83 | Line 134 | type
134		procedure SetAsXSQLVAR(Value: PXSQLVAR);
135		procedure SetIsNull(Value: Boolean);
136		procedure SetIsNullable(Value: Boolean);
137	+	procedure xSetAsBoolean(AValue: boolean);
138	+	procedure xSetAsCurrency(Value: Currency);
139	+	procedure xSetAsInt64(Value: Int64);
140	+	procedure xSetAsDate(Value: TDateTime);
141	+	procedure xSetAsTime(Value: TDateTime);
142	+	procedure xSetAsDateTime(Value: TDateTime);
143	+	procedure xSetAsDouble(Value: Double);
144	+	procedure xSetAsFloat(Value: Float);
145	+	procedure xSetAsLong(Value: Long);
146	+	procedure xSetAsPointer(Value: Pointer);
147	+	procedure xSetAsQuad(Value: TISC_QUAD);
148	+	procedure xSetAsShort(Value: Short);
149	+	procedure xSetAsString(Value: String);
150	+	procedure xSetAsVariant(Value: Variant);
151	+	procedure xSetAsXSQLVAR(Value: PXSQLVAR);
152	+	procedure xSetIsNull(Value: Boolean);
153	+	procedure xSetIsNullable(Value: Boolean);
154		public
155		constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
156		procedure Assign(Source: TIBXSQLVAR);
157	+	procedure Clear;
158		procedure LoadFromFile(const FileName: String);
159		procedure LoadFromStream(Stream: TStream);
160		procedure SaveToFile(const FileName: String);
161		procedure SaveToStream(Stream: TStream);
162		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
163	+	property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
164		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
165		property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
166		property AsDouble: Double read GetAsDouble write SetAsDouble;
#	Line 118 | Line 188 | type
188
189		TIBXSQLVARArray = Array of TIBXSQLVAR;
190
191	<	{ TIBXSQLVAR }
191	>	TIBXSQLDAType = (daInput,daOutput);
192	>
193	>	{ TIBXSQLDA }
194	>
195		TIBXSQLDA = class(TObject)
196		protected
197		FSQL: TIBSQL;
198		FCount: Integer;
126	–	FNames: TStrings;
199		FSize: Integer;
200	+	FInputSQLDA: boolean;
201		FXSQLDA: PXSQLDA;
202		FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
203		FUniqueRelationName: String;
204		function GetModified: Boolean;
132	–	function GetNames: String;
205		function GetRecordSize: Integer;
206		function GetXSQLDA: PXSQLDA;
207		function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
#	Line 137 | Line 209 | type
209		procedure Initialize;
210		procedure SetCount(Value: Integer);
211		public
212	<	constructor Create(Query: TIBSQL);
212	>	constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
213		destructor Destroy; override;
214	<	procedure AddName(FieldName: String; Idx: Integer);
214	>	procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
215		function ByName(Idx: String): TIBXSQLVAR;
216		property AsXSQLDA: PXSQLDA read GetXSQLDA;
217		property Count: Integer read FCount write SetCount;
218		property Modified: Boolean read GetModified;
147	–	property Names: String read GetNames;
219		property RecordSize: Integer read GetRecordSize;
220		property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
221		property UniqueRelationName: String read FUniqueRelationName;
#	Line 178 | Line 249 | type
249		{ TIBOutputDelimitedFile }
250		TIBOutputDelimitedFile = class(TIBBatchOutput)
251		protected
252	+	{$IFDEF UNIX}
253	+	FHandle: cint;
254	+	{$ELSE}
255		FHandle: THandle;
256	+	{$ENDIF}
257		FOutputTitles: Boolean;
258		FColDelimiter,
259		FRowDelimiter: string;
#	Line 217 | Line 292 | type
292		{ TIBOutputRawFile }
293		TIBOutputRawFile = class(TIBBatchOutput)
294		protected
295	+	{$IFDEF UNIX}
296	+	FHandle: cint;
297	+	{$ELSE}
298		FHandle: THandle;
299	+	{$ENDIF}
300		public
301		destructor Destroy; override;
302		procedure ReadyFile; override;
#	Line 227 | Line 306 | type
306		{ TIBInputRawFile }
307		TIBInputRawFile = class(TIBBatchInput)
308		protected
309	+	{$IFDEF UNIX}
310	+	FHandle: cint;
311	+	{$ELSE}
312		FHandle: THandle;
313	+	{$ENDIF}
314		public
315		destructor Destroy; override;
316		function ReadParameters: Boolean; override;
#	Line 245 | Line 328 | type
328		TIBSQL = class(TComponent)
329		private
330		FIBLoaded: Boolean;
331	+	FOnSQLChanged: TNotifyEvent;
332	+	FUniqueParamNames: Boolean;
333	+	function GetFieldCount: integer;
334	+	procedure SetUniqueParamNames(AValue: Boolean);
335		protected
336		FBase: TIBBase;
337		FBOF,                          { At BOF? }
#	Line 280 | Line 367 | type
367		procedure SetSQL(Value: TStrings);
368		procedure SetTransaction(Value: TIBTransaction);
369		procedure SQLChanging(Sender: TObject);
370	<	procedure BeforeTransactionEnd(Sender: TObject);
370	>	procedure SQLChanged(Sender: TObject);
371	>	procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
372		public
373		constructor Create(AOwner: TComponent); override;
374		destructor Destroy; override;
#	Line 294 | Line 382 | type
382		function Current: TIBXSQLDA;
383		procedure ExecQuery;
384		function FieldByName(FieldName: String): TIBXSQLVAR;
385	+	function ParamByName(ParamName: String): TIBXSQLVAR;
386		procedure FreeHandle;
387		function Next: TIBXSQLDA;
388		procedure Prepare;
#	Line 303 | Line 392 | type
392		property Eof: Boolean read GetEOF;
393		property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
394		property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
395	+	property FieldCount: integer read GetFieldCount;
396		property Open: Boolean read FOpen;
397		property Params: TIBXSQLDA read GetSQLParams;
398		property Plan: String read GetPlan;
#	Line 312 | Line 402 | type
402		property SQLType: TIBSQLTypes read FSQLType;
403		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
404		property Handle: TISC_STMT_HANDLE read FHandle;
315	–	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
405		property UniqueRelationName: String read GetUniqueRelationName;
406		published
407		property Database: TIBDatabase read GetDatabase write SetDatabase;
408	+	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
409	+	property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
410		property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
411		write FGoToFirstRecordOnExecute
412		default True;
#	Line 323 | Line 414 | type
414		property SQL: TStrings read FSQL write SetSQL;
415		property Transaction: TIBTransaction read GetTransaction write SetTransaction;
416		property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
417	+	property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
418		end;
419
420		implementation
421
422		uses
423	<	IBIntf, IBBlob, IBSQLMonitor;
423	>	IBIntf, IBBlob, Variants , IBSQLMonitor;
424
425		{ TIBXSQLVAR }
426		constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
#	Line 343 | Line 435 | var
435		szBuff: PChar;
436		s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
437		bSourceBlob, bDestBlob: Boolean;
438	<	iSegs, iMaxSeg, iSize: Long;
438	>	iSegs: Int64;
439	>	iMaxSeg: Int64;
440	>	iSize: Int64;
441		iBlobType: Short;
442		begin
443		szBuff := nil;
#	Line 405 | Line 499 | begin
499		0, nil), True);
500		try
501		IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
502	+	isNull := false
503		finally
504		FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
505		end;
#	Line 424 | Line 519 | end;
519
520		function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
521		var
522	<	Scaling, i: Integer;
522	>	Scaling : Int64;
523	>	i: Integer;
524		Val: Double;
525		begin
526		Scaling := 1; Val := Value;
#	Line 447 | Line 543 | end;
543
544		function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
545		var
546	<	Scaling, i: Integer;
546	>	Scaling : Int64;
547	>	i: Integer;
548		Val: Int64;
549		begin
550		Scaling := 1; Val := Value;
#	Line 463 | Line 560 | end;
560
561		function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
562		var
563	<	Scaling, i : Integer;
563	>	Scaling : Int64;
564	>	i : Integer;
565		FractionText, PadText, CurrText: string;
566		begin
567	<	result := Value;
567	>	Result := 0;
568		Scaling := 1;
569		if Scale > 0 then
570		begin
#	Line 489 | Line 587 | begin
587		try
588		result := StrToCurr(CurrText);
589		except
590	<	on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
590	>	on E: Exception do
591	>	IBError(ibxeInvalidDataConversion, [nil]);
592		end;
593	<	end;
593	>	end
594	>	else
595	>	result := Value;
596	>	end;
597	>
598	>	function TIBXSQLVAR.GetAsBoolean: boolean;
599	>	begin
600	>	result := false;
601	>	if not IsNull then
602	>	begin
603	>	if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
604	>	result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
605	>	else
606	>	IBError(ibxeInvalidDataConversion, [nil]);
607	>	end
608		end;
609
610		function TIBXSQLVAR.GetAsCurrency: Currency;
#	Line 557 | Line 670 | end;
670		function TIBXSQLVAR.GetAsDateTime: TDateTime;
671		var
672		tm_date: TCTimeStructure;
673	+	msecs: word;
674		begin
675		result := 0;
676		if not IsNull then
#	Line 582 | Line 696 | begin
696		SQL_TYPE_TIME: begin
697		isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
698		try
699	+	msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
700		result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
701	<	Word(tm_date.tm_sec), 0)
701	>	Word(tm_date.tm_sec), msecs)
702		except
703		on E: EConvertError do begin
704		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 595 | Line 710 | begin
710		try
711		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
712		Word(tm_date.tm_mday));
713	+	msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
714		if result >= 0 then
715		result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
716	<	Word(tm_date.tm_sec), 0)
716	>	Word(tm_date.tm_sec), msecs)
717		else
718		result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
719	<	Word(tm_date.tm_sec), 0)
719	>	Word(tm_date.tm_sec), msecs)
720		except
721		on E: EConvertError do begin
722		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 730 | Line 846 | begin
846		result := '(Array)'; {do not localize}
847		SQL_BLOB: begin
848		ss := TStringStream.Create('');
849	<	SaveToStream(ss);
850	<	result := ss.DataString;
851	<	ss.Free;
849	>	try
850	>	SaveToStream(ss);
851	>	result := ss.DataString;
852	>	finally
853	>	ss.Free;
854	>	end;
855		end;
856		SQL_TEXT, SQL_VARYING: begin
857		sz := FXSQLVAR^.sqldata;
#	Line 799 | Line 918 | begin
918		result := AsDouble;
919		SQL_INT64:
920		if FXSQLVAR^.sqlscale = 0 then
921	<	IBError(ibxeInvalidDataConversion, [nil])
921	>	result := AsInt64
922		else if FXSQLVAR^.sqlscale >= (-4) then
923		result := AsCurrency
924		else
925		result := AsDouble;
926		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
927		result := AsDouble;
928	+	SQL_BOOLEAN:
929	+	result := AsBoolean;
930		else
931		IBError(ibxeInvalidDataConversion, [nil]);
932		end;
#	Line 894 | Line 1015 | begin
1015		result := FXSQLVAR^.sqltype and (not 1);
1016		end;
1017
1018	+	procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1019	+	var
1020	+	i: Integer;
1021	+	begin
1022	+	if FUniqueName then
1023	+	xSetAsBoolean(AValue)
1024	+	else
1025	+	for i := 0 to FParent.FCount - 1 do
1026	+	if FParent[i].FName = FName then
1027	+	FParent[i].xSetAsBoolean(AValue);
1028	+	end;
1029	+
1030	+	procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1031	+	begin
1032	+	if IsNullable then
1033	+	IsNull := False;
1034	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1035	+	FXSQLVAR^.sqlscale := -4;
1036	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1037	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1038	+	PCurrency(FXSQLVAR^.sqldata)^ := Value;
1039	+	FModified := True;
1040	+	end;
1041	+
1042		procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1043		var
899	–	xvar: TIBXSQLVAR;
1044		i: Integer;
1045		begin
1046		if FSQL.Database.SQLDialect < 3 then
1047		AsDouble := Value
1048		else
1049		begin
1050	<	if IsNullable then
1051	<	IsNull := False;
1050	>
1051	>	if FUniqueName then
1052	>	xSetAsCurrency(Value)
1053	>	else
1054		for i := 0 to FParent.FCount - 1 do
1055	<	if FParent.FNames[i] = FName then
1056	<	begin
911	<	xvar := FParent[i];
912	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
913	<	xvar.FXSQLVAR^.sqlscale := -4;
914	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
915	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
916	<	PCurrency(xvar.FXSQLVAR^.sqldata)^ := Value;
917	<	xvar.FModified := True;
918	<	end;
1055	>	if FParent[i].FName = FName then
1056	>	FParent[i].xSetAsCurrency(Value);
1057		end;
1058		end;
1059
1060	+	procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1061	+	begin
1062	+	if IsNullable then
1063	+	IsNull := False;
1064	+
1065	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1066	+	FXSQLVAR^.sqlscale := 0;
1067	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1068	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1069	+	PInt64(FXSQLVAR^.sqldata)^ := Value;
1070	+	FModified := True;
1071	+	end;
1072	+
1073		procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1074		var
1075		i: Integer;
1076	<	xvar: TIBXSQLVAR;
1076	>	begin
1077	>	if FUniqueName then
1078	>	xSetAsInt64(Value)
1079	>	else
1080	>	for i := 0 to FParent.FCount - 1 do
1081	>	if FParent[i].FName = FName then
1082	>	FParent[i].xSetAsInt64(Value);
1083	>	end;
1084	>
1085	>	procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1086	>	var
1087	>	tm_date: TCTimeStructure;
1088	>	Yr, Mn, Dy: Word;
1089		begin
1090		if IsNullable then
1091		IsNull := False;
1092	<	for i := 0 to FParent.FCount - 1 do
1093	<	if FParent.FNames[i] = FName then
1094	<	begin
1095	<	xvar := FParent[i];
1096	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1097	<	xvar.FXSQLVAR^.sqlscale := 0;
1098	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1099	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1100	<	PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1101	<	xvar.FModified := True;
1102	<	end;
1092	>
1093	>	FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1094	>	DecodeDate(Value, Yr, Mn, Dy);
1095	>	with tm_date do begin
1096	>	tm_sec := 0;
1097	>	tm_min := 0;
1098	>	tm_hour := 0;
1099	>	tm_mday := Dy;
1100	>	tm_mon := Mn - 1;
1101	>	tm_year := Yr - 1900;
1102	>	end;
1103	>	FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1104	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1105	>	isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1106	>	FModified := True;
1107		end;
1108
1109		procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1110		var
1111		i: Integer;
945	–	tm_date: TCTimeStructure;
946	–	Yr, Mn, Dy: Word;
947	–	xvar: TIBXSQLVAR;
1112		begin
1113		if FSQL.Database.SQLDialect < 3 then
1114		begin
1115		AsDateTime := Value;
1116		exit;
1117		end;
1118	+
1119	+	if FUniqueName then
1120	+	xSetAsDate(Value)
1121	+	else
1122	+	for i := 0 to FParent.FCount - 1 do
1123	+	if FParent[i].FName = FName then
1124	+	FParent[i].xSetAsDate(Value);
1125	+	end;
1126	+
1127	+	procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1128	+	var
1129	+	tm_date: TCTimeStructure;
1130	+	Hr, Mt, S, Ms: Word;
1131	+	begin
1132		if IsNullable then
1133		IsNull := False;
1134	<	for i := 0 to FParent.FCount - 1 do
1135	<	if FParent.FNames[i] = FName then
1136	<	begin
1137	<	xvar := FParent[i];
1138	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1139	<	DecodeDate(Value, Yr, Mn, Dy);
1140	<	with tm_date do begin
1141	<	tm_sec := 0;
1142	<	tm_min := 0;
1143	<	tm_hour := 0;
1144	<	tm_mday := Dy;
1145	<	tm_mon := Mn - 1;
1146	<	tm_year := Yr - 1900;
1147	<	end;
1148	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1149	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1150	<	isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
973	<	xvar.FModified := True;
974	<	end;
1134	>
1135	>	FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1136	>	DecodeTime(Value, Hr, Mt, S, Ms);
1137	>	with tm_date do begin
1138	>	tm_sec := S;
1139	>	tm_min := Mt;
1140	>	tm_hour := Hr;
1141	>	tm_mday := 0;
1142	>	tm_mon := 0;
1143	>	tm_year := 0;
1144	>	end;
1145	>	FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1146	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1147	>	isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1148	>	if Ms > 0 then
1149	>	Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1150	>	FModified := True;
1151		end;
1152
1153		procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1154		var
1155		i: Integer;
980	–	tm_date: TCTimeStructure;
981	–	Hr, Mt, S, Ms: Word;
982	–	xvar: TIBXSQLVAR;
1156		begin
1157		if FSQL.Database.SQLDialect < 3 then
1158		begin
1159		AsDateTime := Value;
1160		exit;
1161		end;
1162	<	if IsNullable then
1163	<	IsNull := False;
1162	>
1163	>	if FUniqueName then
1164	>	xSetAsTime(Value)
1165	>	else
1166		for i := 0 to FParent.FCount - 1 do
1167	<	if FParent.FNames[i] = FName then
1168	<	begin
994	<	xvar := FParent[i];
995	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR^.sqltype and 1);
996	<	DecodeTime(Value, Hr, Mt, S, Ms);
997	<	with tm_date do begin
998	<	tm_sec := S;
999	<	tm_min := Mt;
1000	<	tm_hour := Hr;
1001	<	tm_mday := 0;
1002	<	tm_mon := 0;
1003	<	tm_year := 0;
1004	<	end;
1005	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1006	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1007	<	isc_encode_sql_time(@tm_date, PISC_TIME(xvar.FXSQLVAR^.sqldata));
1008	<	xvar.FModified := True;
1009	<	end;
1167	>	if FParent[i].FName = FName then
1168	>	FParent[i].xSetAsTime(Value);
1169		end;
1170
1171	<	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1171	>	procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1172		var
1014	–	i: Integer;
1173		tm_date: TCTimeStructure;
1174		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1017	–	xvar: TIBXSQLVAR;
1175		begin
1176		if IsNullable then
1177		IsNull := False;
1178	+
1179	+	FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1180	+	DecodeDate(Value, Yr, Mn, Dy);
1181	+	DecodeTime(Value, Hr, Mt, S, Ms);
1182	+	with tm_date do begin
1183	+	tm_sec := S;
1184	+	tm_min := Mt;
1185	+	tm_hour := Hr;
1186	+	tm_mday := Dy;
1187	+	tm_mon := Mn - 1;
1188	+	tm_year := Yr - 1900;
1189	+	end;
1190	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1191	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1192	+	isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1193	+	if Ms > 0 then
1194	+	Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1195	+	FModified := True;
1196	+	end;
1197	+
1198	+	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1199	+	var
1200	+	i: Integer;
1201	+	begin
1202	+	if FUniqueName then
1203	+	xSetAsDateTime(value)
1204	+	else
1205		for i := 0 to FParent.FCount - 1 do
1206	<	if FParent.FNames[i] = FName then
1207	<	begin
1208	<	xvar := FParent[i];
1209	<	xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1210	<	DecodeDate(Value, Yr, Mn, Dy);
1211	<	DecodeTime(Value, Hr, Mt, S, Ms);
1212	<	with tm_date do begin
1213	<	tm_sec := S;
1214	<	tm_min := Mt;
1215	<	tm_hour := Hr;
1216	<	tm_mday := Dy;
1217	<	tm_mon := Mn - 1;
1218	<	tm_year := Yr - 1900;
1219	<	end;
1220	<	xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1037	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1038	<	isc_encode_date(@tm_date, PISC_QUAD(xvar.FXSQLVAR^.sqldata));
1039	<	xvar.FModified := True;
1040	<	end;
1206	>	if FParent[i].FName = FName then
1207	>	FParent[i].xSetAsDateTime(Value);
1208	>	end;
1209	>
1210	>	procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1211	>	begin
1212	>	if IsNullable then
1213	>	IsNull := False;
1214	>
1215	>	FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1216	>	FXSQLVAR^.sqllen := SizeOf(Double);
1217	>	FXSQLVAR^.sqlscale := 0;
1218	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1219	>	PDouble(FXSQLVAR^.sqldata)^ := Value;
1220	>	FModified := True;
1221		end;
1222
1223		procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1224		var
1225		i: Integer;
1226	<	xvar: TIBXSQLVAR;
1226	>	begin
1227	>	if FUniqueName then
1228	>	xSetAsDouble(Value)
1229	>	else
1230	>	for i := 0 to FParent.FCount - 1 do
1231	>	if FParent[i].FName = FName then
1232	>	FParent[i].xSetAsDouble(Value);
1233	>	end;
1234	>
1235	>	procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1236		begin
1237		if IsNullable then
1238		IsNull := False;
1239	<	for i := 0 to FParent.FCount - 1 do
1240	<	if FParent.FNames[i] = FName then
1241	<	begin
1242	<	xvar := FParent[i];
1243	<	xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1244	<	xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1245	<	xvar.FXSQLVAR^.sqlscale := 0;
1057	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1058	<	PDouble(xvar.FXSQLVAR^.sqldata)^ := Value;
1059	<	xvar.FModified := True;
1060	<	end;
1239	>
1240	>	FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1241	>	FXSQLVAR^.sqllen := SizeOf(Float);
1242	>	FXSQLVAR^.sqlscale := 0;
1243	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1244	>	PSingle(FXSQLVAR^.sqldata)^ := Value;
1245	>	FModified := True;
1246		end;
1247
1248		procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1249		var
1250		i: Integer;
1251	<	xvar: TIBXSQLVAR;
1251	>	begin
1252	>	if FUniqueName then
1253	>	xSetAsFloat(Value)
1254	>	else
1255	>	for i := 0 to FParent.FCount - 1 do
1256	>	if FParent[i].FName = FName then
1257	>	FParent[i].xSetAsFloat(Value);
1258	>	end;
1259	>
1260	>	procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1261		begin
1262		if IsNullable then
1263		IsNull := False;
1264	<	for i := 0 to FParent.FCount - 1 do
1265	<	if FParent.FNames[i] = FName then
1266	<	begin
1267	<	xvar := FParent[i];
1268	<	xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1269	<	xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1270	<	xvar.FXSQLVAR^.sqlscale := 0;
1077	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1078	<	PSingle(xvar.FXSQLVAR^.sqldata)^ := Value;
1079	<	xvar.FModified := True;
1080	<	end;
1264	>
1265	>	FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1266	>	FXSQLVAR^.sqllen := SizeOf(Long);
1267	>	FXSQLVAR^.sqlscale := 0;
1268	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1269	>	PLong(FXSQLVAR^.sqldata)^ := Value;
1270	>	FModified := True;
1271		end;
1272
1273		procedure TIBXSQLVAR.SetAsLong(Value: Long);
1274		var
1275		i: Integer;
1086	–	xvar: TIBXSQLVAR;
1276		begin
1277	<	if IsNullable then
1278	<	IsNull := False;
1277	>	if FUniqueName then
1278	>	xSetAsLong(Value)
1279	>	else
1280		for i := 0 to FParent.FCount - 1 do
1281	<	if FParent.FNames[i] = FName then
1282	<	begin
1093	<	xvar := FParent[i];
1094	<	xvar.FXSQLVAR^.sqltype := SQL_LONG or (xvar.FXSQLVAR^.sqltype and 1);
1095	<	xvar.FXSQLVAR^.sqllen := SizeOf(Long);
1096	<	xvar.FXSQLVAR^.sqlscale := 0;
1097	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1098	<	PLong(xvar.FXSQLVAR^.sqldata)^ := Value;
1099	<	xvar.FModified := True;
1100	<	end;
1281	>	if FParent[i].FName = FName then
1282	>	FParent[i].xSetAsLong(Value);
1283		end;
1284
1285	<	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1104	<	var
1105	<	i: Integer;
1106	<	xvar: TIBXSQLVAR;
1285	>	procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1286		begin
1287		if IsNullable and (Value = nil) then
1288		IsNull := True
1289		else begin
1290		IsNull := False;
1291	<	for i := 0 to FParent.FCount - 1 do
1292	<	if FParent.FNames[i] = FName then
1114	<	begin
1115	<	xvar := FParent[i];
1116	<	xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1117	<	Move(Value^, xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1118	<	xvar.FModified := True;
1119	<	end;
1291	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1292	>	Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1293		end;
1294	+	FModified := True;
1295	+	end;
1296	+
1297	+	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1298	+	var
1299	+	i: Integer;
1300	+	begin
1301	+	if FUniqueName then
1302	+	xSetAsPointer(Value)
1303	+	else
1304	+	for i := 0 to FParent.FCount - 1 do
1305	+	if FParent[i].FName = FName then
1306	+	FParent[i].xSetAsPointer(Value);
1307	+	end;
1308	+
1309	+	procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1310	+	begin
1311	+	if IsNullable then
1312	+	IsNull := False;
1313	+	if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1314	+	(FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1315	+	IBError(ibxeInvalidDataConversion, [nil]);
1316	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1317	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1318	+	PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1319	+	FModified := True;
1320		end;
1321
1322		procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1323		var
1324		i: Integer;
1325	<	xvar: TIBXSQLVAR;
1325	>	begin
1326	>	if FUniqueName then
1327	>	xSetAsQuad(Value)
1328	>	else
1329	>	for i := 0 to FParent.FCount - 1 do
1330	>	if FParent[i].FName = FName then
1331	>	FParent[i].xSetAsQuad(Value);
1332	>	end;
1333	>
1334	>	procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1335		begin
1336		if IsNullable then
1337		IsNull := False;
1338	<	for i := 0 to FParent.FCount - 1 do
1339	<	if FParent.FNames[i] = FName then
1340	<	begin
1341	<	xvar := FParent[i];
1342	<	if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1343	<	(xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1344	<	IBError(ibxeInvalidDataConversion, [nil]);
1137	<	xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1138	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1139	<	PISC_QUAD(xvar.FXSQLVAR^.sqldata)^ := Value;
1140	<	xvar.FModified := True;
1141	<	end;
1338	>
1339	>	FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1340	>	FXSQLVAR^.sqllen := SizeOf(Short);
1341	>	FXSQLVAR^.sqlscale := 0;
1342	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1343	>	PShort(FXSQLVAR^.sqldata)^ := Value;
1344	>	FModified := True;
1345		end;
1346
1347		procedure TIBXSQLVAR.SetAsShort(Value: Short);
1348		var
1349		i: Integer;
1147	–	xvar: TIBXSQLVAR;
1350		begin
1351	<	if IsNullable then
1352	<	IsNull := False;
1351	>	if FUniqueName then
1352	>	xSetAsShort(Value)
1353	>	else
1354		for i := 0 to FParent.FCount - 1 do
1355	<	if FParent.FNames[i] = FName then
1356	<	begin
1154	<	xvar := FParent[i];
1155	<	xvar.FXSQLVAR^.sqltype := SQL_SHORT or (xvar.FXSQLVAR^.sqltype and 1);
1156	<	xvar.FXSQLVAR^.sqllen := SizeOf(Short);
1157	<	xvar.FXSQLVAR^.sqlscale := 0;
1158	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1159	<	PShort(xvar.FXSQLVAR^.sqldata)^ := Value;
1160	<	xvar.FModified := True;
1161	<	end;
1355	>	if FParent[i].FName = FName then
1356	>	FParent[i].xSetAsShort(Value);
1357		end;
1358
1359	<	procedure TIBXSQLVAR.SetAsString(Value: String);
1359	>	procedure TIBXSQLVAR.xSetAsString(Value: String);
1360		var
1361	<	stype: Integer;
1362	<	ss: TStringStream;
1361	>	stype: Integer;
1362	>	ss: TStringStream;
1363
1364	<	procedure SetStringValue;
1365	<	var
1366	<	i: Integer;
1367	<	xvar: TIBXSQLVAR;
1368	<	begin
1369	<	for i := 0 to FParent.FCount - 1 do
1370	<	if FParent.FNames[i] = FName then
1371	<	begin
1372	<	xvar := FParent[i];
1373	<	if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1374	<	(xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1375	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1376	<	else begin
1182	<	xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1183	<	xvar.FXSQLVAR^.sqllen := Length(Value);
1184	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen + 1);
1185	<	if (Length(Value) > 0) then
1186	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1187	<	end;
1188	<	xvar.FModified := True;
1364	>	procedure SetStringValue;
1365	>	var
1366	>	i: Integer;
1367	>	begin
1368	>	if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1369	>	(FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1370	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1371	>	else begin
1372	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1373	>	FXSQLVAR^.sqllen := Length(Value);
1374	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1375	>	if (Length(Value) > 0) then
1376	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1377		end;
1378	<	end;
1378	>	FModified := True;
1379	>	end;
1380
1381		begin
1382		if IsNullable then
1383		IsNull := False;
1384	+
1385		stype := FXSQLVAR^.sqltype and (not 1);
1386		if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1387		SetStringValue
#	Line 1209 | Line 1399 | begin
1399		IsNull := True
1400		else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1401		(stype = SQL_TYPE_TIME) then
1402	<	SetAsDateTime(StrToDateTime(Value))
1402	>	xSetAsDateTime(StrToDateTime(Value))
1403		else
1404		SetStringValue;
1405		end;
1406		end;
1407
1408	<	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1408	>	procedure TIBXSQLVAR.SetAsString(Value: String);
1409	>	var
1410	>	i: integer;
1411	>	begin
1412	>	if FUniqueName then
1413	>	xSetAsString(Value)
1414	>	else
1415	>	for i := 0 to FParent.FCount - 1 do
1416	>	if FParent[i].FName = FName then
1417	>	FParent[i].xSetAsString(Value);
1418	>	end;
1419	>
1420	>	procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1421		begin
1422		if VarIsNull(Value) then
1423		IsNull := True
1424		else case VarType(Value) of
1425		varEmpty, varNull:
1426		IsNull := True;
1427	<	varSmallint, varInteger, varByte:
1427	>	varSmallint, varInteger, varByte,
1428	>	varWord, varShortInt:
1429		AsLong := Value;
1430	+	varInt64:
1431	+	AsInt64 := Value;
1432		varSingle, varDouble:
1433		AsDouble := Value;
1434		varCurrency:
1435		AsCurrency := Value;
1436		varBoolean:
1437	<	if Value then
1233	<	AsLong := ISC_TRUE
1234	<	else
1235	<	AsLong := ISC_FALSE;
1437	>	AsBoolean := Value;
1438		varDate:
1439		AsDateTime := Value;
1440		varOleStr, varString:
#	Line 1244 | Line 1446 | begin
1446		end;
1447		end;
1448
1449	<	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1449	>	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1450	>	var
1451	>	i: integer;
1452	>	begin
1453	>	if FUniqueName then
1454	>	xSetAsVariant(Value)
1455	>	else
1456	>	for i := 0 to FParent.FCount - 1 do
1457	>	if FParent[i].FName = FName then
1458	>	FParent[i].xSetAsVariant(Value);
1459	>	end;
1460	>
1461	>	procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1462		var
1249	–	i: Integer;
1250	–	xvar: TIBXSQLVAR;
1463		sqlind: PShort;
1464		sqldata: PChar;
1465		local_sqllen: Integer;
1466		begin
1467	<	for i := 0 to FParent.FCount - 1 do
1468	<	if FParent.FNames[i] = FName then
1469	<	begin
1470	<	xvar := FParent[i];
1471	<	sqlind := xvar.FXSQLVAR^.sqlind;
1472	<	sqldata := xvar.FXSQLVAR^.sqldata;
1473	<	Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1474	<	xvar.FXSQLVAR^.sqlind := sqlind;
1475	<	xvar.FXSQLVAR^.sqldata := sqldata;
1476	<	if (Value^.sqltype and 1 = 1) then
1477	<	begin
1478	<	if (xvar.FXSQLVAR^.sqlind = nil) then
1479	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1480	<	xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1481	<	end
1482	<	else
1483	<	if (xvar.FXSQLVAR^.sqlind <> nil) then
1484	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1485	<	if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1486	<	local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1487	<	else
1488	<	local_sqllen := xvar.FXSQLVAR^.sqllen;
1277	<	FXSQLVAR^.sqlscale := Value^.sqlscale;
1278	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen);
1279	<	Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen);
1280	<	xvar.FModified := True;
1281	<	end;
1467	>	sqlind := FXSQLVAR^.sqlind;
1468	>	sqldata := FXSQLVAR^.sqldata;
1469	>	Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1470	>	FXSQLVAR^.sqlind := sqlind;
1471	>	FXSQLVAR^.sqldata := sqldata;
1472	>	if (Value^.sqltype and 1 = 1) then
1473	>	begin
1474	>	if (FXSQLVAR^.sqlind = nil) then
1475	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1476	>	FXSQLVAR^.sqlind^ := Value^.sqlind^;
1477	>	end
1478	>	else
1479	>	if (FXSQLVAR^.sqlind <> nil) then
1480	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1481	>	if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1482	>	local_sqllen := FXSQLVAR^.sqllen + 2
1483	>	else
1484	>	local_sqllen := FXSQLVAR^.sqllen;
1485	>	FXSQLVAR^.sqlscale := Value^.sqlscale;
1486	>	IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1487	>	Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1488	>	FModified := True;
1489		end;
1490
1491	<	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1491	>	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1492		var
1493		i: Integer;
1494	<	xvar: TIBXSQLVAR;
1494	>	begin
1495	>	if FUniqueName then
1496	>	xSetAsXSQLVAR(Value)
1497	>	else
1498	>	for i := 0 to FParent.FCount - 1 do
1499	>	if FParent[i].FName = FName then
1500	>	FParent[i].xSetAsXSQLVAR(Value);
1501	>	end;
1502	>
1503	>	procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1504		begin
1505		if Value then
1506		begin
1507		if not IsNullable then
1508		IsNullable := True;
1509	<	for i := 0 to FParent.FCount - 1 do
1510	<	if FParent.FNames[i] = FName then
1511	<	begin
1512	<	xvar := FParent[i];
1513	<	xvar.FXSQLVAR^.sqlind^ := -1;
1514	<	xvar.FModified := True;
1515	<	end;
1516	<	end else if ((not Value) and IsNullable) then
1509	>
1510	>	if Assigned(FXSQLVAR^.sqlind) then
1511	>	FXSQLVAR^.sqlind^ := -1;
1512	>	FModified := True;
1513	>	end
1514	>	else
1515	>	if ((not Value) and IsNullable) then
1516	>	begin
1517	>	if Assigned(FXSQLVAR^.sqlind) then
1518	>	FXSQLVAR^.sqlind^ := 0;
1519	>	FModified := True;
1520	>	end;
1521	>	end;
1522	>
1523	>	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1524	>	var
1525	>	i: Integer;
1526	>	begin
1527	>	if FUniqueName then
1528	>	xSetIsNull(Value)
1529	>	else
1530	>	for i := 0 to FParent.FCount - 1 do
1531	>	if FParent[i].FName = FName then
1532	>	FParent[i].xSetIsNull(Value);
1533	>	end;
1534	>
1535	>	procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1536	>	begin
1537	>	if (Value <> IsNullable) then
1538		begin
1539	<	for i := 0 to FParent.FCount - 1 do
1540	<	if FParent.FNames[i] = FName then
1541	<	begin
1542	<	xvar := FParent[i];
1543	<	xvar.FXSQLVAR^.sqlind^ := 0;
1544	<	xvar.FModified := True;
1545	<	end;
1539	>	if Value then
1540	>	begin
1541	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1542	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1543	>	end
1544	>	else
1545	>	begin
1546	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1547	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1548	>	end;
1549		end;
1550		end;
1551
1552		procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1553		var
1554		i: Integer;
1315	–	xvar: TIBXSQLVAR;
1555		begin
1556	+	if FUniqueName then
1557	+	xSetIsNullable(Value)
1558	+	else
1559		for i := 0 to FParent.FCount - 1 do
1560	<	if FParent.FNames[i] = FName then
1561	<	begin
1320	<	xvar := FParent[i];
1321	<	if (Value <> IsNullable) then
1322	<	begin
1323	<	if Value then
1324	<	begin
1325	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1326	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1327	<	end
1328	<	else
1329	<	begin
1330	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1331	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1332	<	end;
1333	<	end;
1334	<	end;
1560	>	if FParent[i].FName = FName then
1561	>	FParent[i].xSetIsNullable(Value);
1562		end;
1563
1564	+	procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1565	+	begin
1566	+	if IsNullable then
1567	+	IsNull := False;
1568	+
1569	+	FXSQLVAR^.sqltype := SQL_BOOLEAN;
1570	+	FXSQLVAR^.sqllen := 1;
1571	+	FXSQLVAR^.sqlscale := 0;
1572	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1573	+	if AValue then
1574	+	PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1575	+	else
1576	+	PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1577	+	FModified := True;
1578	+	end;
1579	+
1580	+	procedure TIBXSQLVAR.Clear;
1581	+	begin
1582	+	IsNull := true;
1583	+	end;
1584	+
1585	+
1586		{ TIBXSQLDA }
1587	<	constructor TIBXSQLDA.Create(Query: TIBSQL);
1587	>	constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1588		begin
1589		inherited Create;
1590		FSQL := Query;
1342	–	FNames := TStringList.Create;
1591		FSize := 0;
1592		FUniqueRelationName := '';
1593	+	FInputSQLDA := sqldaType = daInput;
1594		end;
1595
1596		destructor TIBXSQLDA.Destroy;
1597		var
1598		i: Integer;
1599		begin
1351	–	FNames.Free;
1600		if FXSQLDA <> nil then
1601		begin
1602		for i := 0 to FSize - 1 do
#	Line 1361 | Line 1609 | begin
1609		FXSQLDA := nil;
1610		FXSQLVARs := nil;
1611		end;
1612	<	inherited;
1612	>	inherited Destroy;
1613		end;
1614
1615	<	procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1615	>	procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1616	>	UniqueName: boolean);
1617		var
1618	<	fn: String;
1618	>	fn: string;
1619		begin
1620	<	fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1621	<	while FNames.Count <= Idx do
1622	<	FNames.Add('');
1623	<	FNames[Idx] := fn;
1624	<	FXSQLVARs[Idx].FName := fn;
1620	>	{$ifdef UseCaseSensitiveParamName}
1621	>	FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1622	>	{$else}
1623	>	FXSQLVARs[Idx].FName := FieldName;
1624	>	{$endif}
1625		FXSQLVARs[Idx].FIndex := Idx;
1626	+	FXSQLVARs[Idx].FUniqueName :=  UniqueName
1627		end;
1628
1629		function TIBXSQLDA.GetModified: Boolean;
#	Line 1389 | Line 1639 | begin
1639		end;
1640		end;
1641
1392	–	function TIBXSQLDA.GetNames: String;
1393	–	begin
1394	–	result := FNames.Text;
1395	–	end;
1396	–
1642		function TIBXSQLDA.GetRecordSize: Integer;
1643		begin
1644		result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
#	Line 1421 | Line 1666 | end;
1666		function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1667		var
1668		s: String;
1669	<	i, Cnt: Integer;
1669	>	i: Integer;
1670		begin
1671	<	s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1672	<	i := 0;
1673	<	Cnt := FNames.Count;
1674	<	while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1675	<	if i = Cnt then
1676	<	result := nil
1677	<	else
1678	<	result := GetXSQLVAR(i);
1671	>	{$ifdef ALLOWDIALECT3PARAMNAMES}
1672	>	s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1673	>	{$else}
1674	>	{$ifdef UseCaseSensitiveParamName}
1675	>	s := AnsiUpperCase(Idx);
1676	>	{$else}
1677	>	s := Idx;
1678	>	{$endif}
1679	>	{$endif}
1680	>	for i := 0 to FCount - 1 do
1681	>	if Vars[i].FName = s then
1682	>	begin
1683	>	Result := FXSQLVARs[i];
1684	>	Exit;
1685	>	end;
1686	>	Result := nil;
1687		end;
1688
1689		procedure TIBXSQLDA.Initialize;
1690	+
1691	+	function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1692	+	var
1693	+	k: integer;
1694	+	begin
1695	+	for k := 0 to limit do
1696	+	if FXSQLVARs[k].FName = idx then
1697	+	begin
1698	+	Result := FXSQLVARs[k];
1699	+	Exit;
1700	+	end;
1701	+	Result := nil;
1702	+	end;
1703	+
1704		var
1705		i, j, j_len: Integer;
1439	–	NamesWereEmpty: Boolean;
1706		st: String;
1707		bUnique: Boolean;
1708	+	sBaseName: string;
1709		begin
1710		bUnique := True;
1711	<	NamesWereEmpty := (FNames.Count = 0);
1712	<	if FXSQLDA <> nil then begin
1713	<	for i := 0 to FCount - 1 do begin
1714	<	with FXSQLVARs[i].Data^ do begin
1715	<	if bUnique and (String(relname) <> '') then
1711	>	if FXSQLDA <> nil then
1712	>	begin
1713	>	for i := 0 to FCount - 1 do
1714	>	begin
1715	>	with FXSQLVARs[i].Data^ do
1716	>	begin
1717	>
1718	>	{First get the unique relation name, if any}
1719	>
1720	>	if bUnique and (strpas(relname) <> '') then
1721		begin
1722		if FUniqueRelationName = '' then
1723	<	FUniqueRelationName := String(relname)
1724	<	else if String(relname) <> FUniqueRelationName then
1725	<	begin
1726	<	FUniqueRelationName := '';
1727	<	bUnique := False;
1728	<	end;
1723	>	FUniqueRelationName := strpas(relname)
1724	>	else
1725	>	if strpas(relname) <> FUniqueRelationName then
1726	>	begin
1727	>	FUniqueRelationName := '';
1728	>	bUnique := False;
1729	>	end;
1730		end;
1731	<	if NamesWereEmpty then begin
1732	<	st := String(aliasname);
1733	<	if st = '' then begin
1734	<	st := 'F_'; {do not localize}
1731	>
1732	>	{If an output SQLDA then copy the aliasnames to the FName list. Ensure
1733	>	that they are all upper case only and disambiguated.
1734	>	}
1735	>
1736	>	if not FInputSQLDA then
1737	>	begin
1738	>	st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1739	>	if st = '' then
1740	>	begin
1741	>	sBaseName := 'F_'; {do not localize}
1742		aliasname_length := 2;
1743		j := 1; j_len := 1;
1744	<	StrPCopy(aliasname, st + IntToStr(j));
1745	<	end else begin
1746	<	StrPCopy(aliasname, st);
1744	>	st := sBaseName + IntToStr(j);
1745	>	end
1746	>	else
1747	>	begin
1748		j := 0; j_len := 0;
1749	+	sBaseName := st;
1750		end;
1751	<	while GetXSQLVARByName(String(aliasname)) <> nil do begin
1752	<	Inc(j); j_len := Length(IntToStr(j));
1753	<	if j_len + aliasname_length > 31 then
1754	<	StrPCopy(aliasname,
1755	<	Copy(st, 1, 31 - j_len) +
1756	<	IntToStr(j))
1757	<	else
1758	<	StrPCopy(aliasname, st + IntToStr(j));
1751	>
1752	>	{Look for other columns with the same name and make unique}
1753	>
1754	>	while VarByName(st,i-1) <> nil do
1755	>	begin
1756	>	Inc(j);
1757	>	j_len := Length(IntToStr(j));
1758	>	if j_len + Length(sBaseName) > 31 then
1759	>	st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1760	>	else
1761	>	st := sBaseName + IntToStr(j);
1762		end;
1763	<	Inc(aliasname_length, j_len);
1764	<	AddName(String(aliasname), i);
1763	>
1764	>	FXSQLVARs[i].FName := st;
1765		end;
1766	+
1767	+	{Finally initialise the XSQLVAR}
1768	+
1769	+	FXSQLVARs[i].FIndex := i;
1770	+
1771		case sqltype and (not 1) of
1772		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1773	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1773	>	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1774		SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1775		if (sqllen = 0) then
1776		{ Make sure you get a valid pointer anyway
#	Line 1510 | Line 1800 | var
1800		i, OldSize: Integer;
1801		p : PXSQLVAR;
1802		begin
1513	–	FNames.Clear;
1803		FCount := Value;
1804		if FCount = 0 then
1805		FUniqueRelationName := ''
#	Line 1532 | Line 1821 | begin
1821		FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1822		FXSQLVARs[i].FXSQLVAR := p;
1823		p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1535	–	//        FNames.Add('');
1824		end;
1825		FSize := FCount;
1826		end;
#	Line 1548 | Line 1836 | end;
1836
1837		destructor TIBOutputDelimitedFile.Destroy;
1838		begin
1839	+	{$IFDEF UNIX}
1840	+	if FHandle <> -1 then
1841	+	fpclose(FHandle);
1842	+	{$ELSE}
1843		if FHandle <> 0 then
1844		begin
1845		FlushFileBuffers(FHandle);
1846		CloseHandle(FHandle);
1847		end;
1848	+	{$ENDIF}
1849		inherited Destroy;
1850		end;
1851
1852		procedure TIBOutputDelimitedFile.ReadyFile;
1853		var
1854		i: Integer;
1855	+	{$IFDEF UNIX}
1856	+	BytesWritten: cint;
1857	+	{$ELSE}
1858		BytesWritten: DWORD;
1859	+	{$ENDIF}
1860		st: string;
1861		begin
1862		if FColDelimiter = '' then
1863		FColDelimiter := TAB;
1864		if FRowDelimiter = '' then
1865		FRowDelimiter := CRLF;
1866	+	{$IFDEF UNIX}
1867	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1868	+	{$ELSE}
1869		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1870		FILE_ATTRIBUTE_NORMAL, 0);
1871		if FHandle = INVALID_HANDLE_VALUE then
1872		FHandle := 0;
1873	+	{$ENDIF}
1874		if FOutputTitles then
1875		begin
1876		for i := 0 to Columns.Count - 1 do
1877		if i = 0 then
1878	<	st := string(Columns[i].Data^.aliasname)
1878	>	st := strpas(Columns[i].Data^.aliasname)
1879		else
1880	<	st := st + FColDelimiter + string(Columns[i].Data^.aliasname);
1880	>	st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1881		st := st + FRowDelimiter;
1882	+	{$IFDEF UNIX}
1883	+	if FHandle <> -1 then
1884	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1885	+	if BytesWritten = -1 then
1886	+	raise Exception.Create('File Write Error');
1887	+	{$ELSE}
1888		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1889	+	{$ENDIF}
1890		end;
1891		end;
1892
1893		function TIBOutputDelimitedFile.WriteColumns: Boolean;
1894		var
1895		i: Integer;
1896	+	{$IFDEF UNIX}
1897	+	BytesWritten: cint;
1898	+	{$ELSE}
1899		BytesWritten: DWORD;
1900	+	{$ENDIF}
1901		st: string;
1902		begin
1903		result := False;
1904	+	{$IFDEF UNIX}
1905	+	if FHandle <> -1 then
1906	+	{$ELSE}
1907		if FHandle <> 0 then
1908	+	{$ENDIF}
1909		begin
1910		st := '';
1911		for i := 0 to Columns.Count - 1 do
#	Line 1599 | Line 1915 | begin
1915		st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1916		end;
1917		st := st + FRowDelimiter;
1918	+	{$IFDEF UNIX}
1919	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1920	+	{$ELSE}
1921		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1922	+	{$ENDIF}
1923		if BytesWritten = DWORD(Length(st)) then
1924		result := True;
1925		end
#	Line 1712 | Line 2032 | end;
2032		{ TIBOutputRawFile }
2033		destructor TIBOutputRawFile.Destroy;
2034		begin
2035	+	{$IFDEF UNIX}
2036	+	if FHandle <> -1 then
2037	+	fpclose(FHandle);
2038	+	{$ELSE}
2039		if FHandle <> 0 then
2040		begin
2041		FlushFileBuffers(FHandle);
2042		CloseHandle(FHandle);
2043		end;
2044	+	{$ENDIF}
2045		inherited Destroy;
2046		end;
2047
2048		procedure TIBOutputRawFile.ReadyFile;
2049		begin
2050	+	{$IFDEF UNIX}
2051	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
2052	+	{$ELSE}
2053		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
2054		FILE_ATTRIBUTE_NORMAL, 0);
2055		if FHandle = INVALID_HANDLE_VALUE then
2056		FHandle := 0;
2057	+	{$ENDIF}
2058		end;
2059
2060		function TIBOutputRawFile.WriteColumns: Boolean;
#	Line 1738 | Line 2067 | begin
2067		begin
2068		for i := 0 to Columns.Count - 1 do
2069		begin
2070	+	{$IFDEF UNIX}
2071	+	BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
2072	+	{$ELSE}
2073		WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
2074		BytesWritten, nil);
2075	+	{$ENDIF}
2076		if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
2077		exit;
2078		end;
#	Line 1750 | Line 2083 | end;
2083		{ TIBInputRawFile }
2084		destructor TIBInputRawFile.Destroy;
2085		begin
2086	+	{$IFDEF UNIX}
2087	+	if FHandle <> -1 then
2088	+	fpclose(FHandle);
2089	+	{$ELSE}
2090		if FHandle <> 0 then
2091		CloseHandle(FHandle);
2092	<	inherited;
2092	>	{$ENDIF}
2093	>	inherited Destroy;
2094		end;
2095
2096		function TIBInputRawFile.ReadParameters: Boolean;
#	Line 1761 | Line 2099 | var
2099		BytesRead: DWord;
2100		begin
2101		result := False;
2102	+	{$IFDEF UNIX}
2103	+	if FHandle <> -1 then
2104	+	{$ELSE}
2105		if FHandle <> 0 then
2106	+	{$ENDIF}
2107		begin
2108		for i := 0 to Params.Count - 1 do
2109		begin
2110	+	{$IFDEF UNIX}
2111	+	BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
2112	+	{$ELSE}
2113		ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
2114		BytesRead, nil);
2115	+	{$ENDIF}
2116		if BytesRead <> DWORD(Params[i].Data^.sqllen) then
2117		exit;
2118		end;
#	Line 1776 | Line 2122 | end;
2122
2123		procedure TIBInputRawFile.ReadyFile;
2124		begin
2125	+	{$IFDEF UNIX}
2126	+	if FHandle <> -1 then
2127	+	fpclose(FHandle);
2128	+	FHandle := FpOpen(Filename,O_RdOnly);
2129	+	if FHandle = -1 then
2130	+	raise Exception.CreateFmt('Unable to open file %s',[Filename]);
2131	+	{$ELSE}
2132		if FHandle <> 0 then
2133		CloseHandle(FHandle);
2134		FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
2135		FILE_FLAG_SEQUENTIAL_SCAN, 0);
2136		if FHandle = INVALID_HANDLE_VALUE then
2137		FHandle := 0;
2138	+	{$ENDIF}
2139		end;
2140
2141		{ TIBSQL }
#	Line 1802 | Line 2156 | begin
2156		FRecordCount := 0;
2157		FSQL := TStringList.Create;
2158		TStringList(FSQL).OnChanging := SQLChanging;
2159	+	TStringList(FSQL).OnChange := SQLChanged;
2160		FProcessedSQL := TStringList.Create;
2161		FHandle := nil;
2162	<	FSQLParams := TIBXSQLDA.Create(self);
2163	<	FSQLRecord := TIBXSQLDA.Create(self);
2162	>	FSQLParams := TIBXSQLDA.Create(self,daInput);
2163	>	FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2164		FSQLType := SQLUnknown;
2165		FParamCheck := True;
2166	<	FCursor := Name + RandomString(8);
2166	>	FCursor := HexStr(self); //Name + RandomString(8);
2167		if AOwner is TIBDatabase then
2168		Database := TIBDatabase(AOwner)
2169		else
#	Line 1830 | Line 2185 | begin
2185		FSQLParams.Free;
2186		FSQLRecord.Free;
2187		end;
2188	<	inherited;
2188	>	inherited Destroy;
2189		end;
2190
2191		procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
#	Line 1918 | Line 2273 | begin
2273		result := FSQLRecord;
2274		end;
2275
2276	+	function TIBSQL.GetFieldCount: integer;
2277	+	begin
2278	+	Result := FSQLRecord.Count
2279	+	end;
2280	+
2281	+	procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2282	+	begin
2283	+	if FUniqueParamNames = AValue then Exit;
2284	+	FreeHandle;
2285	+	FUniqueParamNames := AValue;
2286	+	end;
2287	+
2288		procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2289		begin
2290		if (FHandle <> nil) then begin
#	Line 1948 | Line 2315 | begin
2315		FBOF := True;
2316		FEOF := False;
2317		FRecordCount := 0;
2318	+	if not (csDesigning in ComponentState) then
2319	+	MonitorHook.SQLExecute(Self);
2320		if FGoToFirstRecordOnExecute then
2321		Next;
2322		end;
#	Line 1957 | Line 2326 | begin
2326		@FHandle,
2327		Database.SQLDialect,
2328		FSQLParams.AsXSQLDA,
2329	<	FSQLRecord.AsXSQLDA), False);
2330	<	if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2329	>	FSQLRecord.AsXSQLDA), True);
2330	>	if not (csDesigning in ComponentState) then
2331	>	MonitorHook.SQLExecute(Self);
2332	>	(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2333		begin
2334		{ Sometimes a prepared stored procedure appears to get
2335		off sync on the server ....This code is meant to try
#	Line 1973 | Line 2344 | begin
2344		Database.SQLDialect,
2345		FSQLParams.AsXSQLDA,
2346		FSQLRecord.AsXSQLDA), True);
2347	<	end;
2347	>	end;  *)
2348		end
2349		else
2350		Call(isc_dsql_execute(StatusVector,
2351		TRHandle,
2352		@FHandle,
2353		Database.SQLDialect,
2354	<	FSQLParams.AsXSQLDA), True)
2354	>	FSQLParams.AsXSQLDA), True);
2355	>	if not (csDesigning in ComponentState) then
2356	>	MonitorHook.SQLExecute(Self);
2357		end;
2358	<	if not (csDesigning in ComponentState) then
2359	<	MonitorHook.SQLExecute(Self);
2358	>	FBase.DoAfterExecQuery(self);
2359	>	//  writeln('Rows Affected = ',RowsAffected);
2360		end;
2361
2362		function TIBSQL.GetEOF: Boolean;
#	Line 2001 | Line 2374 | begin
2374		result := GetFields(i);
2375		end;
2376
2377	+	function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2378	+	begin
2379	+	Result := Params.ByName(ParamName);
2380	+	end;
2381	+
2382		function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2383		begin
2384		if (Idx < 0) or (Idx >= FSQLRecord.Count) then
#	Line 2090 | Line 2468 | begin
2468		SQLUpdate, SQLDelete])) then
2469		result := ''
2470		else begin
2471	<	info_request := Char(isc_info_sql_get_plan);
2471	>	info_request := isc_info_sql_get_plan;
2472		Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2473		SizeOf(result_buffer), result_buffer), True);
2474	<	if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2474	>	if (result_buffer[0] <> isc_info_sql_get_plan) then
2475		IBError(ibxeUnknownError, [nil]);
2476		result_length := isc_vax_integer(@result_buffer[1], 2);
2477		SetString(result, nil, result_length);
#	Line 2108 | Line 2486 | begin
2486		result := FRecordCount;
2487		end;
2488
2489	<	function TIBSQL.GetRowsAffected: integer;
2489	>	function TIBSQL.GetRowsAffected: Integer;
2490		var
2113	–	result_buffer: array[0..1048] of Char;
2491		info_request: Char;
2492	+	RB: TResultBuffer;
2493		begin
2494		if not Prepared then
2495		result := -1
2496		else begin
2497	<	info_request := Char(isc_info_sql_records);
2498	<	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2499	<	SizeOf(result_buffer), result_buffer) > 0 then
2500	<	IBDatabaseError;
2501	<	if (result_buffer[0] <> Char(isc_info_sql_records)) then
2502	<	result := -1
2503	<	else
2504	<	case SQLType of
2505	<	SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2506	<	SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2507	<	SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2508	<	else         Result := -1 ;
2509	<	end ;
2497	>	RB := TResultBuffer.Create;
2498	>	try
2499	>	info_request := isc_info_sql_records;
2500	>	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2501	>	RB.Size, RB.buffer) > 0 then
2502	>	IBDatabaseError;
2503	>	case SQLType of
2504	>	SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2505	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2506	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2507	>	SQLDelete:
2508	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2509	>	SQLExecProcedure:
2510	>	Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2511	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2512	>	RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2513	>	else
2514	>	Result := 0;
2515	>	end;
2516	>	finally
2517	>	RB.Free;
2518	>	end;
2519		end;
2520		end;
2521
#	Line 2159 | Line 2546 | var
2546		cCurChar, cNextChar, cQuoteChar: Char;
2547		sSQL, sProcessedSQL, sParamName: String;
2548		i, iLenSQL, iSQLPos: Integer;
2549	<	iCurState, iCurParamState: Integer;
2549	>	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2550		iParamSuffix: Integer;
2551		slNames: TStrings;
2552
#	Line 2168 | Line 2555 | const
2555		CommentState = 1;
2556		QuoteState = 2;
2557		ParamState = 3;
2558	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2559		ParamDefaultState = 0;
2560		ParamQuoteState = 1;
2561	+	{$endif}
2562
2563		procedure AddToProcessedSQL(cChar: Char);
2564		begin
#	Line 2178 | Line 2567 | const
2567		end;
2568
2569		begin
2570	+	sParamName := '';
2571		slNames := TStringList.Create;
2572		try
2573		{ Do some initializations of variables }
#	Line 2189 | Line 2579 | begin
2579		i := 1;
2580		iSQLPos := 1;
2581		iCurState := DefaultState;
2582	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2583		iCurParamState := ParamDefaultState;
2584	+	{$endif}
2585		{ Now, traverse through the SQL string, character by character,
2586		picking out the parameters and formatting correctly for InterBase }
2587		while (i <= iLenSQL) do begin
#	Line 2240 | Line 2632 | begin
2632		ParamState:
2633		begin
2634		{ collect the name of the parameter }
2635	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2636		if iCurParamState = ParamDefaultState then
2637		begin
2638		if cCurChar = '"' then
2639		iCurParamState := ParamQuoteState
2640	<	else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2640	>	else
2641	>	{$endif}
2642	>	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2643		sParamName := sParamName + cCurChar
2644		else if FGenerateParamNames then
2645		begin
2646		sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2647		Inc(iParamSuffix);
2648		iCurState := DefaultState;
2649	<	slNames.Add(sParamName);
2649	>	slNames.AddObject(sParamName,self); //Note local convention
2650	>	//add pointer to self to mark entry
2651		sParamName := '';
2652		end
2653		else
2654		IBError(ibxeSQLParseError, [SParamNameExpected]);
2655	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2656		end
2657		else begin
2658		{ determine if Quoted parameter name is finished }
#	Line 2270 | Line 2667 | begin
2667		else
2668		sParamName := sParamName + cCurChar
2669		end;
2670	+	{$endif}
2671		{ determine if the unquoted parameter name is finished }
2672	<	if (iCurParamState <> ParamQuoteState) and
2672	>	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2673		(iCurState <> DefaultState) then
2674		begin
2675		if not (cNextChar in ['A'..'Z', 'a'..'z',
#	Line 2291 | Line 2689 | begin
2689		AddToProcessedSQL(#0);
2690		FSQLParams.Count := slNames.Count;
2691		for i := 0 to slNames.Count - 1 do
2692	<	FSQLParams.AddName(slNames[i], i);
2692	>	FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2693		FProcessedSQL.Text := sProcessedSQL;
2694		finally
2695		slNames.Free;
#	Line 2330 | Line 2728 | begin
2728		{ After preparing the statement, query the stmt type and possibly
2729		create a FSQLRecord "holder" }
2730		{ Get the type of the statement }
2731	<	type_item := Char(isc_info_sql_stmt_type);
2731	>	type_item := isc_info_sql_stmt_type;
2732		Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2733		SizeOf(res_buffer), res_buffer), True);
2734	<	if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2734	>	if (res_buffer[0] <> isc_info_sql_stmt_type) then
2735		IBError(ibxeUnknownError, [nil]);
2736		stmt_len := isc_vax_integer(@res_buffer[1], 2);
2737		FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
#	Line 2378 | Line 2776 | begin
2776		on E: Exception do begin
2777		if (FHandle <> nil) then
2778		FreeHandle;
2779	<	raise;
2779	>	if E is EIBInterBaseError then
2780	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2781	>	EIBInterBaseError(E).IBErrorCode,
2782	>	EIBInterBaseError(E).Message +
2783	>	sSQLErrorSeparator + FProcessedSQL.Text)
2784	>	else
2785	>	raise;
2786		end;
2787		end;
2788		end;
#	Line 2416 | Line 2820 | begin
2820		if FHandle <> nil then FreeHandle;
2821		end;
2822
2823	<	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2823	>	procedure TIBSQL.SQLChanged(Sender: TObject);
2824	>	begin
2825	>	if assigned(OnSQLChanged) then
2826	>	OnSQLChanged(self);
2827	>	end;
2828	>
2829	>	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2830	>	Action: TTransactionAction);
2831		begin
2832		if (FOpen) then
2833		Close;

Diff Legend

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