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 39 by tony, Tue May 17 08:14:52 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	+	{$IF FPC_FULLVERSION >= 20700 }
39	+	{$codepage UTF8}
40	+	{$ENDIF}
41	+
42	+	{ IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
43	+
44	+	Dialect 3 quoted format parameter names represent a significant overhead and are of
45	+	limited value - especially for users that use only TIBSQL or TIBCustomDataset
46	+	descendents. They were previously used internally by IBX to simplify SQL generation
47	+	for TTable components in Master/Slave relationships which are linked by
48	+	Dialect 3 names. They were also generated by TStoredProc when the original
49	+	parameter names are quoted.
50	+
51	+	However, for some users they do cause a big processing overhead. The TTable/TStoredProc
52	+	code has been re-written so that they are no required by IBX internally.
53	+	The code to support quoted parameter names is now subject  to conditional compilation.
54	+	To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled.
55	+
56	+	Hint: deleting the space between the brace and the dollar sign below
57	+
58	+	}
59	+
60	+	{ $define ALLOWDIALECT3PARAMNAMES}
61	+
62	+	{$ifndef ALLOWDIALECT3PARAMNAMES}
63	+
64	+	{ Even when dialect 3 quoted format parameter names are not supported, IBX still processes
65	+	parameter names case insensitive. This does result in some additional overhead
66	+	due to a call to "AnsiUpperCase". This can be avoided by undefining
67	+	"UseCaseSensitiveParamName" below.
68	+
69	+	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
70	+	is defined. This will not give a useful result.
71	+	}
72	+	{$define UseCaseSensitiveParamName}
73	+	{$endif}
74	+
75		interface
76
77		uses
78	<	Windows, SysUtils, Classes, Forms, Controls, IBHeader,
78	>	{$IFDEF WINDOWS }
79	>	Windows,
80	>	{$ELSE}
81	>	baseunix, unix,
82	>	{$ENDIF}
83	>	SysUtils, Classes, IBHeader,
84		IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
85
86	+	const
87	+	sSQLErrorSeparator = ' When Executing: ';
88	+
89		type
90		TIBSQL = class;
91		TIBXSQLDA = class;
#	Line 46 | Line 98 | type
98		FIndex: Integer;
99		FModified: Boolean;
100		FName: String;
101	+	FUniqueName: boolean;
102		FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
103
104		function AdjustScale(Value: Int64; Scale: Integer): Double;
105		function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
106		function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
107	+	function GetAsBoolean: boolean;
108		function GetAsCurrency: Currency;
109		function GetAsInt64: Int64;
110		function GetAsDateTime: TDateTime;
#	Line 67 | Line 121 | type
121		function GetIsNullable: Boolean;
122		function GetSize: Integer;
123		function GetSQLType: Integer;
124	+	procedure SetAsBoolean(AValue: boolean);
125		procedure SetAsCurrency(Value: Currency);
126		procedure SetAsInt64(Value: Int64);
127		procedure SetAsDate(Value: TDateTime);
128	+	procedure SetAsLong(Value: Long);
129		procedure SetAsTime(Value: TDateTime);
130		procedure SetAsDateTime(Value: TDateTime);
131		procedure SetAsDouble(Value: Double);
132		procedure SetAsFloat(Value: Float);
77	–	procedure SetAsLong(Value: Long);
133		procedure SetAsPointer(Value: Pointer);
134		procedure SetAsQuad(Value: TISC_QUAD);
135		procedure SetAsShort(Value: Short);
#	Line 83 | Line 138 | type
138		procedure SetAsXSQLVAR(Value: PXSQLVAR);
139		procedure SetIsNull(Value: Boolean);
140		procedure SetIsNullable(Value: Boolean);
141	+	procedure xSetAsBoolean(AValue: boolean);
142	+	procedure xSetAsCurrency(Value: Currency);
143	+	procedure xSetAsInt64(Value: Int64);
144	+	procedure xSetAsDate(Value: TDateTime);
145	+	procedure xSetAsTime(Value: TDateTime);
146	+	procedure xSetAsDateTime(Value: TDateTime);
147	+	procedure xSetAsDouble(Value: Double);
148	+	procedure xSetAsFloat(Value: Float);
149	+	procedure xSetAsLong(Value: Long);
150	+	procedure xSetAsPointer(Value: Pointer);
151	+	procedure xSetAsQuad(Value: TISC_QUAD);
152	+	procedure xSetAsShort(Value: Short);
153	+	procedure xSetAsString(Value: String);
154	+	procedure xSetAsVariant(Value: Variant);
155	+	procedure xSetAsXSQLVAR(Value: PXSQLVAR);
156	+	procedure xSetIsNull(Value: Boolean);
157	+	procedure xSetIsNullable(Value: Boolean);
158		public
159		constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
160		procedure Assign(Source: TIBXSQLVAR);
161	+	procedure Clear;
162		procedure LoadFromFile(const FileName: String);
163		procedure LoadFromStream(Stream: TStream);
164		procedure SaveToFile(const FileName: String);
165		procedure SaveToStream(Stream: TStream);
166		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
167	+	property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
168		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
169		property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
170		property AsDouble: Double read GetAsDouble write SetAsDouble;
#	Line 118 | Line 192 | type
192
193		TIBXSQLVARArray = Array of TIBXSQLVAR;
194
195	<	{ TIBXSQLVAR }
195	>	TIBXSQLDAType = (daInput,daOutput);
196	>
197	>	{ TIBXSQLDA }
198	>
199		TIBXSQLDA = class(TObject)
200		protected
201		FSQL: TIBSQL;
202		FCount: Integer;
126	–	FNames: TStrings;
203		FSize: Integer;
204	+	FInputSQLDA: boolean;
205		FXSQLDA: PXSQLDA;
206		FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
207		FUniqueRelationName: String;
208		function GetModified: Boolean;
132	–	function GetNames: String;
209		function GetRecordSize: Integer;
210		function GetXSQLDA: PXSQLDA;
211		function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
#	Line 137 | Line 213 | type
213		procedure Initialize;
214		procedure SetCount(Value: Integer);
215		public
216	<	constructor Create(Query: TIBSQL);
216	>	constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
217		destructor Destroy; override;
218	<	procedure AddName(FieldName: String; Idx: Integer);
218	>	procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
219		function ByName(Idx: String): TIBXSQLVAR;
220		property AsXSQLDA: PXSQLDA read GetXSQLDA;
221		property Count: Integer read FCount write SetCount;
222		property Modified: Boolean read GetModified;
147	–	property Names: String read GetNames;
223		property RecordSize: Integer read GetRecordSize;
224		property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
225		property UniqueRelationName: String read FUniqueRelationName;
#	Line 178 | Line 253 | type
253		{ TIBOutputDelimitedFile }
254		TIBOutputDelimitedFile = class(TIBBatchOutput)
255		protected
256	+	{$IFDEF UNIX}
257	+	FHandle: cint;
258	+	{$ELSE}
259		FHandle: THandle;
260	+	{$ENDIF}
261		FOutputTitles: Boolean;
262		FColDelimiter,
263		FRowDelimiter: string;
#	Line 217 | Line 296 | type
296		{ TIBOutputRawFile }
297		TIBOutputRawFile = class(TIBBatchOutput)
298		protected
299	+	{$IFDEF UNIX}
300	+	FHandle: cint;
301	+	{$ELSE}
302		FHandle: THandle;
303	+	{$ENDIF}
304		public
305		destructor Destroy; override;
306		procedure ReadyFile; override;
#	Line 227 | Line 310 | type
310		{ TIBInputRawFile }
311		TIBInputRawFile = class(TIBBatchInput)
312		protected
313	+	{$IFDEF UNIX}
314	+	FHandle: cint;
315	+	{$ELSE}
316		FHandle: THandle;
317	+	{$ENDIF}
318		public
319		destructor Destroy; override;
320		function ReadParameters: Boolean; override;
#	Line 245 | Line 332 | type
332		TIBSQL = class(TComponent)
333		private
334		FIBLoaded: Boolean;
335	+	FOnSQLChanged: TNotifyEvent;
336	+	FUniqueParamNames: Boolean;
337	+	function GetFieldCount: integer;
338	+	procedure SetUniqueParamNames(AValue: Boolean);
339		protected
340		FBase: TIBBase;
341		FBOF,                          { At BOF? }
#	Line 280 | Line 371 | type
371		procedure SetSQL(Value: TStrings);
372		procedure SetTransaction(Value: TIBTransaction);
373		procedure SQLChanging(Sender: TObject);
374	<	procedure BeforeTransactionEnd(Sender: TObject);
374	>	procedure SQLChanged(Sender: TObject);
375	>	procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
376		public
377		constructor Create(AOwner: TComponent); override;
378		destructor Destroy; override;
#	Line 294 | Line 386 | type
386		function Current: TIBXSQLDA;
387		procedure ExecQuery;
388		function FieldByName(FieldName: String): TIBXSQLVAR;
389	+	function ParamByName(ParamName: String): TIBXSQLVAR;
390		procedure FreeHandle;
391		function Next: TIBXSQLDA;
392		procedure Prepare;
#	Line 303 | Line 396 | type
396		property Eof: Boolean read GetEOF;
397		property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
398		property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
399	+	property FieldCount: integer read GetFieldCount;
400		property Open: Boolean read FOpen;
401		property Params: TIBXSQLDA read GetSQLParams;
402		property Plan: String read GetPlan;
#	Line 312 | Line 406 | type
406		property SQLType: TIBSQLTypes read FSQLType;
407		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
408		property Handle: TISC_STMT_HANDLE read FHandle;
315	–	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
409		property UniqueRelationName: String read GetUniqueRelationName;
410		published
411		property Database: TIBDatabase read GetDatabase write SetDatabase;
412	+	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
413	+	property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
414		property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
415		write FGoToFirstRecordOnExecute
416		default True;
#	Line 323 | Line 418 | type
418		property SQL: TStrings read FSQL write SetSQL;
419		property Transaction: TIBTransaction read GetTransaction write SetTransaction;
420		property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
421	+	property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
422		end;
423
424		implementation
425
426		uses
427	<	IBIntf, IBBlob, IBSQLMonitor;
427	>	IBIntf, IBBlob, Variants , IBSQLMonitor;
428
429		{ TIBXSQLVAR }
430		constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
#	Line 343 | Line 439 | var
439		szBuff: PChar;
440		s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
441		bSourceBlob, bDestBlob: Boolean;
442	<	iSegs, iMaxSeg, iSize: Long;
442	>	iSegs: Int64;
443	>	iMaxSeg: Int64;
444	>	iSize: Int64;
445		iBlobType: Short;
446		begin
447		szBuff := nil;
#	Line 405 | Line 503 | begin
503		0, nil), True);
504		try
505		IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
506	+	isNull := false
507		finally
508		FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
509		end;
#	Line 424 | Line 523 | end;
523
524		function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
525		var
526	<	Scaling, i: Integer;
526	>	Scaling : Int64;
527	>	i: Integer;
528		Val: Double;
529		begin
530		Scaling := 1; Val := Value;
#	Line 447 | Line 547 | end;
547
548		function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
549		var
550	<	Scaling, i: Integer;
550	>	Scaling : Int64;
551	>	i: Integer;
552		Val: Int64;
553		begin
554		Scaling := 1; Val := Value;
#	Line 463 | Line 564 | end;
564
565		function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
566		var
567	<	Scaling, i : Integer;
567	>	Scaling : Int64;
568	>	i : Integer;
569		FractionText, PadText, CurrText: string;
570		begin
571	<	result := Value;
571	>	Result := 0;
572		Scaling := 1;
573		if Scale > 0 then
574		begin
#	Line 489 | Line 591 | begin
591		try
592		result := StrToCurr(CurrText);
593		except
594	<	on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
594	>	on E: Exception do
595	>	IBError(ibxeInvalidDataConversion, [nil]);
596		end;
597	<	end;
597	>	end
598	>	else
599	>	result := Value;
600	>	end;
601	>
602	>	function TIBXSQLVAR.GetAsBoolean: boolean;
603	>	begin
604	>	result := false;
605	>	if not IsNull then
606	>	begin
607	>	if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
608	>	result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
609	>	else
610	>	IBError(ibxeInvalidDataConversion, [nil]);
611	>	end
612		end;
613
614		function TIBXSQLVAR.GetAsCurrency: Currency;
#	Line 557 | Line 674 | end;
674		function TIBXSQLVAR.GetAsDateTime: TDateTime;
675		var
676		tm_date: TCTimeStructure;
677	+	msecs: word;
678		begin
679		result := 0;
680		if not IsNull then
#	Line 582 | Line 700 | begin
700		SQL_TYPE_TIME: begin
701		isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
702		try
703	+	msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
704		result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
705	<	Word(tm_date.tm_sec), 0)
705	>	Word(tm_date.tm_sec), msecs)
706		except
707		on E: EConvertError do begin
708		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 595 | Line 714 | begin
714		try
715		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
716		Word(tm_date.tm_mday));
717	+	msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
718		if result >= 0 then
719		result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
720	<	Word(tm_date.tm_sec), 0)
720	>	Word(tm_date.tm_sec), msecs)
721		else
722		result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
723	<	Word(tm_date.tm_sec), 0)
723	>	Word(tm_date.tm_sec), msecs)
724		except
725		on E: EConvertError do begin
726		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 730 | Line 850 | begin
850		result := '(Array)'; {do not localize}
851		SQL_BLOB: begin
852		ss := TStringStream.Create('');
853	<	SaveToStream(ss);
854	<	result := ss.DataString;
855	<	ss.Free;
853	>	try
854	>	SaveToStream(ss);
855	>	result := ss.DataString;
856	>	finally
857	>	ss.Free;
858	>	end;
859		end;
860		SQL_TEXT, SQL_VARYING: begin
861		sz := FXSQLVAR^.sqldata;
#	Line 799 | Line 922 | begin
922		result := AsDouble;
923		SQL_INT64:
924		if FXSQLVAR^.sqlscale = 0 then
925	<	IBError(ibxeInvalidDataConversion, [nil])
925	>	result := AsInt64
926		else if FXSQLVAR^.sqlscale >= (-4) then
927		result := AsCurrency
928		else
929		result := AsDouble;
930		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
931		result := AsDouble;
932	+	SQL_BOOLEAN:
933	+	result := AsBoolean;
934		else
935		IBError(ibxeInvalidDataConversion, [nil]);
936		end;
#	Line 894 | Line 1019 | begin
1019		result := FXSQLVAR^.sqltype and (not 1);
1020		end;
1021
1022	+	procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1023	+	var
1024	+	i: Integer;
1025	+	begin
1026	+	if FUniqueName then
1027	+	xSetAsBoolean(AValue)
1028	+	else
1029	+	for i := 0 to FParent.FCount - 1 do
1030	+	if FParent[i].FName = FName then
1031	+	FParent[i].xSetAsBoolean(AValue);
1032	+	end;
1033	+
1034	+	procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1035	+	begin
1036	+	if IsNullable then
1037	+	IsNull := False;
1038	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1039	+	FXSQLVAR^.sqlscale := -4;
1040	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1041	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1042	+	PCurrency(FXSQLVAR^.sqldata)^ := Value;
1043	+	FModified := True;
1044	+	end;
1045	+
1046		procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1047		var
899	–	xvar: TIBXSQLVAR;
1048		i: Integer;
1049		begin
1050		if FSQL.Database.SQLDialect < 3 then
1051		AsDouble := Value
1052		else
1053		begin
1054	<	if IsNullable then
1055	<	IsNull := False;
1054	>
1055	>	if FUniqueName then
1056	>	xSetAsCurrency(Value)
1057	>	else
1058		for i := 0 to FParent.FCount - 1 do
1059	<	if FParent.FNames[i] = FName then
1060	<	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;
1059	>	if FParent[i].FName = FName then
1060	>	FParent[i].xSetAsCurrency(Value);
1061		end;
1062		end;
1063
1064	+	procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1065	+	begin
1066	+	if IsNullable then
1067	+	IsNull := False;
1068	+
1069	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1070	+	FXSQLVAR^.sqlscale := 0;
1071	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1072	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1073	+	PInt64(FXSQLVAR^.sqldata)^ := Value;
1074	+	FModified := True;
1075	+	end;
1076	+
1077		procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1078		var
1079		i: Integer;
1080	<	xvar: TIBXSQLVAR;
1080	>	begin
1081	>	if FUniqueName then
1082	>	xSetAsInt64(Value)
1083	>	else
1084	>	for i := 0 to FParent.FCount - 1 do
1085	>	if FParent[i].FName = FName then
1086	>	FParent[i].xSetAsInt64(Value);
1087	>	end;
1088	>
1089	>	procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1090	>	var
1091	>	tm_date: TCTimeStructure;
1092	>	Yr, Mn, Dy: Word;
1093		begin
1094		if IsNullable then
1095		IsNull := False;
1096	<	for i := 0 to FParent.FCount - 1 do
1097	<	if FParent.FNames[i] = FName then
1098	<	begin
1099	<	xvar := FParent[i];
1100	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1101	<	xvar.FXSQLVAR^.sqlscale := 0;
1102	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1103	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1104	<	PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1105	<	xvar.FModified := True;
1106	<	end;
1096	>
1097	>	FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1098	>	DecodeDate(Value, Yr, Mn, Dy);
1099	>	with tm_date do begin
1100	>	tm_sec := 0;
1101	>	tm_min := 0;
1102	>	tm_hour := 0;
1103	>	tm_mday := Dy;
1104	>	tm_mon := Mn - 1;
1105	>	tm_year := Yr - 1900;
1106	>	end;
1107	>	FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1108	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1109	>	isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1110	>	FModified := True;
1111		end;
1112
1113		procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1114		var
1115		i: Integer;
945	–	tm_date: TCTimeStructure;
946	–	Yr, Mn, Dy: Word;
947	–	xvar: TIBXSQLVAR;
1116		begin
1117		if FSQL.Database.SQLDialect < 3 then
1118		begin
1119		AsDateTime := Value;
1120		exit;
1121		end;
1122	+
1123	+	if FUniqueName then
1124	+	xSetAsDate(Value)
1125	+	else
1126	+	for i := 0 to FParent.FCount - 1 do
1127	+	if FParent[i].FName = FName then
1128	+	FParent[i].xSetAsDate(Value);
1129	+	end;
1130	+
1131	+	procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1132	+	var
1133	+	tm_date: TCTimeStructure;
1134	+	Hr, Mt, S, Ms: Word;
1135	+	begin
1136		if IsNullable then
1137		IsNull := False;
1138	<	for i := 0 to FParent.FCount - 1 do
1139	<	if FParent.FNames[i] = FName then
1140	<	begin
1141	<	xvar := FParent[i];
1142	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1143	<	DecodeDate(Value, Yr, Mn, Dy);
1144	<	with tm_date do begin
1145	<	tm_sec := 0;
1146	<	tm_min := 0;
1147	<	tm_hour := 0;
1148	<	tm_mday := Dy;
1149	<	tm_mon := Mn - 1;
1150	<	tm_year := Yr - 1900;
1151	<	end;
1152	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1153	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1154	<	isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
973	<	xvar.FModified := True;
974	<	end;
1138	>
1139	>	FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1140	>	DecodeTime(Value, Hr, Mt, S, Ms);
1141	>	with tm_date do begin
1142	>	tm_sec := S;
1143	>	tm_min := Mt;
1144	>	tm_hour := Hr;
1145	>	tm_mday := 0;
1146	>	tm_mon := 0;
1147	>	tm_year := 0;
1148	>	end;
1149	>	FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1150	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1151	>	isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1152	>	if Ms > 0 then
1153	>	Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1154	>	FModified := True;
1155		end;
1156
1157		procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1158		var
1159		i: Integer;
980	–	tm_date: TCTimeStructure;
981	–	Hr, Mt, S, Ms: Word;
982	–	xvar: TIBXSQLVAR;
1160		begin
1161		if FSQL.Database.SQLDialect < 3 then
1162		begin
1163		AsDateTime := Value;
1164		exit;
1165		end;
1166	<	if IsNullable then
1167	<	IsNull := False;
1166	>
1167	>	if FUniqueName then
1168	>	xSetAsTime(Value)
1169	>	else
1170		for i := 0 to FParent.FCount - 1 do
1171	<	if FParent.FNames[i] = FName then
1172	<	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;
1171	>	if FParent[i].FName = FName then
1172	>	FParent[i].xSetAsTime(Value);
1173		end;
1174
1175	<	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1175	>	procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1176		var
1014	–	i: Integer;
1177		tm_date: TCTimeStructure;
1178		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1017	–	xvar: TIBXSQLVAR;
1179		begin
1180		if IsNullable then
1181		IsNull := False;
1182	+
1183	+	FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1184	+	DecodeDate(Value, Yr, Mn, Dy);
1185	+	DecodeTime(Value, Hr, Mt, S, Ms);
1186	+	with tm_date do begin
1187	+	tm_sec := S;
1188	+	tm_min := Mt;
1189	+	tm_hour := Hr;
1190	+	tm_mday := Dy;
1191	+	tm_mon := Mn - 1;
1192	+	tm_year := Yr - 1900;
1193	+	end;
1194	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1195	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1196	+	isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1197	+	if Ms > 0 then
1198	+	Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1199	+	FModified := True;
1200	+	end;
1201	+
1202	+	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1203	+	var
1204	+	i: Integer;
1205	+	begin
1206	+	if FUniqueName then
1207	+	xSetAsDateTime(value)
1208	+	else
1209		for i := 0 to FParent.FCount - 1 do
1210	<	if FParent.FNames[i] = FName then
1211	<	begin
1212	<	xvar := FParent[i];
1213	<	xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1214	<	DecodeDate(Value, Yr, Mn, Dy);
1215	<	DecodeTime(Value, Hr, Mt, S, Ms);
1216	<	with tm_date do begin
1217	<	tm_sec := S;
1218	<	tm_min := Mt;
1219	<	tm_hour := Hr;
1220	<	tm_mday := Dy;
1221	<	tm_mon := Mn - 1;
1222	<	tm_year := Yr - 1900;
1223	<	end;
1224	<	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;
1210	>	if FParent[i].FName = FName then
1211	>	FParent[i].xSetAsDateTime(Value);
1212	>	end;
1213	>
1214	>	procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1215	>	begin
1216	>	if IsNullable then
1217	>	IsNull := False;
1218	>
1219	>	FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1220	>	FXSQLVAR^.sqllen := SizeOf(Double);
1221	>	FXSQLVAR^.sqlscale := 0;
1222	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1223	>	PDouble(FXSQLVAR^.sqldata)^ := Value;
1224	>	FModified := True;
1225		end;
1226
1227		procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1228		var
1229		i: Integer;
1230	<	xvar: TIBXSQLVAR;
1230	>	begin
1231	>	if FUniqueName then
1232	>	xSetAsDouble(Value)
1233	>	else
1234	>	for i := 0 to FParent.FCount - 1 do
1235	>	if FParent[i].FName = FName then
1236	>	FParent[i].xSetAsDouble(Value);
1237	>	end;
1238	>
1239	>	procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1240		begin
1241		if IsNullable then
1242		IsNull := False;
1243	<	for i := 0 to FParent.FCount - 1 do
1244	<	if FParent.FNames[i] = FName then
1245	<	begin
1246	<	xvar := FParent[i];
1247	<	xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1248	<	xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1249	<	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;
1243	>
1244	>	FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1245	>	FXSQLVAR^.sqllen := SizeOf(Float);
1246	>	FXSQLVAR^.sqlscale := 0;
1247	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1248	>	PSingle(FXSQLVAR^.sqldata)^ := Value;
1249	>	FModified := True;
1250		end;
1251
1252		procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1253		var
1254		i: Integer;
1255	<	xvar: TIBXSQLVAR;
1255	>	begin
1256	>	if FUniqueName then
1257	>	xSetAsFloat(Value)
1258	>	else
1259	>	for i := 0 to FParent.FCount - 1 do
1260	>	if FParent[i].FName = FName then
1261	>	FParent[i].xSetAsFloat(Value);
1262	>	end;
1263	>
1264	>	procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1265		begin
1266		if IsNullable then
1267		IsNull := False;
1268	<	for i := 0 to FParent.FCount - 1 do
1269	<	if FParent.FNames[i] = FName then
1270	<	begin
1271	<	xvar := FParent[i];
1272	<	xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1273	<	xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1274	<	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;
1268	>
1269	>	FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1270	>	FXSQLVAR^.sqllen := SizeOf(Long);
1271	>	FXSQLVAR^.sqlscale := 0;
1272	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1273	>	PLong(FXSQLVAR^.sqldata)^ := Value;
1274	>	FModified := True;
1275		end;
1276
1277		procedure TIBXSQLVAR.SetAsLong(Value: Long);
1278		var
1279		i: Integer;
1086	–	xvar: TIBXSQLVAR;
1280		begin
1281	<	if IsNullable then
1282	<	IsNull := False;
1281	>	if FUniqueName then
1282	>	xSetAsLong(Value)
1283	>	else
1284		for i := 0 to FParent.FCount - 1 do
1285	<	if FParent.FNames[i] = FName then
1286	<	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;
1285	>	if FParent[i].FName = FName then
1286	>	FParent[i].xSetAsLong(Value);
1287		end;
1288
1289	<	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1104	<	var
1105	<	i: Integer;
1106	<	xvar: TIBXSQLVAR;
1289	>	procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1290		begin
1291		if IsNullable and (Value = nil) then
1292		IsNull := True
1293		else begin
1294		IsNull := False;
1295	<	for i := 0 to FParent.FCount - 1 do
1296	<	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;
1295	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1296	>	Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1297		end;
1298	+	FModified := True;
1299	+	end;
1300	+
1301	+	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1302	+	var
1303	+	i: Integer;
1304	+	begin
1305	+	if FUniqueName then
1306	+	xSetAsPointer(Value)
1307	+	else
1308	+	for i := 0 to FParent.FCount - 1 do
1309	+	if FParent[i].FName = FName then
1310	+	FParent[i].xSetAsPointer(Value);
1311	+	end;
1312	+
1313	+	procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1314	+	begin
1315	+	if IsNullable then
1316	+	IsNull := False;
1317	+	if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1318	+	(FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1319	+	IBError(ibxeInvalidDataConversion, [nil]);
1320	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1321	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1322	+	PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1323	+	FModified := True;
1324		end;
1325
1326		procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1327		var
1328		i: Integer;
1329	<	xvar: TIBXSQLVAR;
1329	>	begin
1330	>	if FUniqueName then
1331	>	xSetAsQuad(Value)
1332	>	else
1333	>	for i := 0 to FParent.FCount - 1 do
1334	>	if FParent[i].FName = FName then
1335	>	FParent[i].xSetAsQuad(Value);
1336	>	end;
1337	>
1338	>	procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1339		begin
1340		if IsNullable then
1341		IsNull := False;
1342	<	for i := 0 to FParent.FCount - 1 do
1343	<	if FParent.FNames[i] = FName then
1344	<	begin
1345	<	xvar := FParent[i];
1346	<	if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1347	<	(xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1348	<	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;
1342	>
1343	>	FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1344	>	FXSQLVAR^.sqllen := SizeOf(Short);
1345	>	FXSQLVAR^.sqlscale := 0;
1346	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1347	>	PShort(FXSQLVAR^.sqldata)^ := Value;
1348	>	FModified := True;
1349		end;
1350
1351		procedure TIBXSQLVAR.SetAsShort(Value: Short);
1352		var
1353		i: Integer;
1147	–	xvar: TIBXSQLVAR;
1354		begin
1355	<	if IsNullable then
1356	<	IsNull := False;
1355	>	if FUniqueName then
1356	>	xSetAsShort(Value)
1357	>	else
1358		for i := 0 to FParent.FCount - 1 do
1359	<	if FParent.FNames[i] = FName then
1360	<	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;
1359	>	if FParent[i].FName = FName then
1360	>	FParent[i].xSetAsShort(Value);
1361		end;
1362
1363	<	procedure TIBXSQLVAR.SetAsString(Value: String);
1363	>	procedure TIBXSQLVAR.xSetAsString(Value: String);
1364		var
1365	<	stype: Integer;
1366	<	ss: TStringStream;
1365	>	stype: Integer;
1366	>	ss: TStringStream;
1367
1368	<	procedure SetStringValue;
1369	<	var
1370	<	i: Integer;
1371	<	xvar: TIBXSQLVAR;
1372	<	begin
1373	<	for i := 0 to FParent.FCount - 1 do
1374	<	if FParent.FNames[i] = FName then
1375	<	begin
1376	<	xvar := FParent[i];
1377	<	if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1378	<	(xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1379	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1380	<	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;
1368	>	procedure SetStringValue;
1369	>	var
1370	>	i: Integer;
1371	>	begin
1372	>	if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1373	>	(FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1374	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1375	>	else begin
1376	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1377	>	FXSQLVAR^.sqllen := Length(Value);
1378	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1379	>	if (Length(Value) > 0) then
1380	>	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1381		end;
1382	<	end;
1382	>	FModified := True;
1383	>	end;
1384
1385		begin
1386		if IsNullable then
1387		IsNull := False;
1388	+
1389		stype := FXSQLVAR^.sqltype and (not 1);
1390		if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1391		SetStringValue
#	Line 1209 | Line 1403 | begin
1403		IsNull := True
1404		else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1405		(stype = SQL_TYPE_TIME) then
1406	<	SetAsDateTime(StrToDateTime(Value))
1406	>	xSetAsDateTime(StrToDateTime(Value))
1407		else
1408		SetStringValue;
1409		end;
1410		end;
1411
1412	<	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1412	>	procedure TIBXSQLVAR.SetAsString(Value: String);
1413	>	var
1414	>	i: integer;
1415	>	begin
1416	>	if FUniqueName then
1417	>	xSetAsString(Value)
1418	>	else
1419	>	for i := 0 to FParent.FCount - 1 do
1420	>	if FParent[i].FName = FName then
1421	>	FParent[i].xSetAsString(Value);
1422	>	end;
1423	>
1424	>	procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1425		begin
1426		if VarIsNull(Value) then
1427		IsNull := True
1428		else case VarType(Value) of
1429		varEmpty, varNull:
1430		IsNull := True;
1431	<	varSmallint, varInteger, varByte:
1431	>	varSmallint, varInteger, varByte,
1432	>	varWord, varShortInt:
1433		AsLong := Value;
1434	+	varInt64:
1435	+	AsInt64 := Value;
1436		varSingle, varDouble:
1437		AsDouble := Value;
1438		varCurrency:
1439		AsCurrency := Value;
1440		varBoolean:
1441	<	if Value then
1233	<	AsLong := ISC_TRUE
1234	<	else
1235	<	AsLong := ISC_FALSE;
1441	>	AsBoolean := Value;
1442		varDate:
1443		AsDateTime := Value;
1444		varOleStr, varString:
#	Line 1244 | Line 1450 | begin
1450		end;
1451		end;
1452
1453	<	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1453	>	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1454	>	var
1455	>	i: integer;
1456	>	begin
1457	>	if FUniqueName then
1458	>	xSetAsVariant(Value)
1459	>	else
1460	>	for i := 0 to FParent.FCount - 1 do
1461	>	if FParent[i].FName = FName then
1462	>	FParent[i].xSetAsVariant(Value);
1463	>	end;
1464	>
1465	>	procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1466		var
1249	–	i: Integer;
1250	–	xvar: TIBXSQLVAR;
1467		sqlind: PShort;
1468		sqldata: PChar;
1469		local_sqllen: Integer;
1470		begin
1471	<	for i := 0 to FParent.FCount - 1 do
1472	<	if FParent.FNames[i] = FName then
1473	<	begin
1474	<	xvar := FParent[i];
1475	<	sqlind := xvar.FXSQLVAR^.sqlind;
1476	<	sqldata := xvar.FXSQLVAR^.sqldata;
1477	<	Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1478	<	xvar.FXSQLVAR^.sqlind := sqlind;
1479	<	xvar.FXSQLVAR^.sqldata := sqldata;
1480	<	if (Value^.sqltype and 1 = 1) then
1481	<	begin
1482	<	if (xvar.FXSQLVAR^.sqlind = nil) then
1483	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1484	<	xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1485	<	end
1486	<	else
1487	<	if (xvar.FXSQLVAR^.sqlind <> nil) then
1488	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1489	<	if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1490	<	local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1491	<	else
1492	<	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;
1471	>	sqlind := FXSQLVAR^.sqlind;
1472	>	sqldata := FXSQLVAR^.sqldata;
1473	>	Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1474	>	FXSQLVAR^.sqlind := sqlind;
1475	>	FXSQLVAR^.sqldata := sqldata;
1476	>	if (Value^.sqltype and 1 = 1) then
1477	>	begin
1478	>	if (FXSQLVAR^.sqlind = nil) then
1479	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1480	>	FXSQLVAR^.sqlind^ := Value^.sqlind^;
1481	>	end
1482	>	else
1483	>	if (FXSQLVAR^.sqlind <> nil) then
1484	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1485	>	if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1486	>	local_sqllen := FXSQLVAR^.sqllen + 2
1487	>	else
1488	>	local_sqllen := FXSQLVAR^.sqllen;
1489	>	FXSQLVAR^.sqlscale := Value^.sqlscale;
1490	>	IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1491	>	Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1492	>	FModified := True;
1493		end;
1494
1495	<	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1495	>	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1496		var
1497		i: Integer;
1498	<	xvar: TIBXSQLVAR;
1498	>	begin
1499	>	if FUniqueName then
1500	>	xSetAsXSQLVAR(Value)
1501	>	else
1502	>	for i := 0 to FParent.FCount - 1 do
1503	>	if FParent[i].FName = FName then
1504	>	FParent[i].xSetAsXSQLVAR(Value);
1505	>	end;
1506	>
1507	>	procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1508		begin
1509		if Value then
1510		begin
1511		if not IsNullable then
1512		IsNullable := True;
1513	<	for i := 0 to FParent.FCount - 1 do
1514	<	if FParent.FNames[i] = FName then
1515	<	begin
1516	<	xvar := FParent[i];
1517	<	xvar.FXSQLVAR^.sqlind^ := -1;
1518	<	xvar.FModified := True;
1519	<	end;
1520	<	end else if ((not Value) and IsNullable) then
1513	>
1514	>	if Assigned(FXSQLVAR^.sqlind) then
1515	>	FXSQLVAR^.sqlind^ := -1;
1516	>	FModified := True;
1517	>	end
1518	>	else
1519	>	if ((not Value) and IsNullable) then
1520	>	begin
1521	>	if Assigned(FXSQLVAR^.sqlind) then
1522	>	FXSQLVAR^.sqlind^ := 0;
1523	>	FModified := True;
1524	>	end;
1525	>	end;
1526	>
1527	>	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1528	>	var
1529	>	i: Integer;
1530	>	begin
1531	>	if FUniqueName then
1532	>	xSetIsNull(Value)
1533	>	else
1534	>	for i := 0 to FParent.FCount - 1 do
1535	>	if FParent[i].FName = FName then
1536	>	FParent[i].xSetIsNull(Value);
1537	>	end;
1538	>
1539	>	procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1540	>	begin
1541	>	if (Value <> IsNullable) then
1542		begin
1543	<	for i := 0 to FParent.FCount - 1 do
1544	<	if FParent.FNames[i] = FName then
1545	<	begin
1546	<	xvar := FParent[i];
1547	<	xvar.FXSQLVAR^.sqlind^ := 0;
1548	<	xvar.FModified := True;
1549	<	end;
1543	>	if Value then
1544	>	begin
1545	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1546	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1547	>	end
1548	>	else
1549	>	begin
1550	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1551	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1552	>	end;
1553		end;
1554		end;
1555
1556		procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1557		var
1558		i: Integer;
1315	–	xvar: TIBXSQLVAR;
1559		begin
1560	+	if FUniqueName then
1561	+	xSetIsNullable(Value)
1562	+	else
1563		for i := 0 to FParent.FCount - 1 do
1564	<	if FParent.FNames[i] = FName then
1565	<	begin
1566	<	xvar := FParent[i];
1567	<	if (Value <> IsNullable) then
1568	<	begin
1569	<	if Value then
1570	<	begin
1571	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1572	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1573	<	end
1574	<	else
1575	<	begin
1576	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1577	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1578	<	end;
1579	<	end;
1580	<	end;
1564	>	if FParent[i].FName = FName then
1565	>	FParent[i].xSetIsNullable(Value);
1566	>	end;
1567	>
1568	>	procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1569	>	begin
1570	>	if IsNullable then
1571	>	IsNull := False;
1572	>
1573	>	FXSQLVAR^.sqltype := SQL_BOOLEAN;
1574	>	FXSQLVAR^.sqllen := 1;
1575	>	FXSQLVAR^.sqlscale := 0;
1576	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1577	>	if AValue then
1578	>	PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1579	>	else
1580	>	PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1581	>	FModified := True;
1582		end;
1583
1584	+	procedure TIBXSQLVAR.Clear;
1585	+	begin
1586	+	IsNull := true;
1587	+	end;
1588	+
1589	+
1590		{ TIBXSQLDA }
1591	<	constructor TIBXSQLDA.Create(Query: TIBSQL);
1591	>	constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1592		begin
1593		inherited Create;
1594		FSQL := Query;
1342	–	FNames := TStringList.Create;
1595		FSize := 0;
1596		FUniqueRelationName := '';
1597	+	FInputSQLDA := sqldaType = daInput;
1598		end;
1599
1600		destructor TIBXSQLDA.Destroy;
1601		var
1602		i: Integer;
1603		begin
1351	–	FNames.Free;
1604		if FXSQLDA <> nil then
1605		begin
1606		for i := 0 to FSize - 1 do
#	Line 1361 | Line 1613 | begin
1613		FXSQLDA := nil;
1614		FXSQLVARs := nil;
1615		end;
1616	<	inherited;
1616	>	inherited Destroy;
1617		end;
1618
1619	<	procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1619	>	procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1620	>	UniqueName: boolean);
1621		var
1622	<	fn: String;
1622	>	fn: string;
1623		begin
1624	<	fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1625	<	while FNames.Count <= Idx do
1626	<	FNames.Add('');
1627	<	FNames[Idx] := fn;
1628	<	FXSQLVARs[Idx].FName := fn;
1624	>	{$ifdef UseCaseSensitiveParamName}
1625	>	FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1626	>	{$else}
1627	>	FXSQLVARs[Idx].FName := FieldName;
1628	>	{$endif}
1629		FXSQLVARs[Idx].FIndex := Idx;
1630	+	FXSQLVARs[Idx].FUniqueName :=  UniqueName
1631		end;
1632
1633		function TIBXSQLDA.GetModified: Boolean;
#	Line 1389 | Line 1643 | begin
1643		end;
1644		end;
1645
1392	–	function TIBXSQLDA.GetNames: String;
1393	–	begin
1394	–	result := FNames.Text;
1395	–	end;
1396	–
1646		function TIBXSQLDA.GetRecordSize: Integer;
1647		begin
1648		result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
#	Line 1421 | Line 1670 | end;
1670		function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1671		var
1672		s: String;
1673	<	i, Cnt: Integer;
1673	>	i: Integer;
1674		begin
1675	<	s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1676	<	i := 0;
1677	<	Cnt := FNames.Count;
1678	<	while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1679	<	if i = Cnt then
1680	<	result := nil
1681	<	else
1682	<	result := GetXSQLVAR(i);
1675	>	{$ifdef ALLOWDIALECT3PARAMNAMES}
1676	>	s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1677	>	{$else}
1678	>	{$ifdef UseCaseSensitiveParamName}
1679	>	s := AnsiUpperCase(Idx);
1680	>	{$else}
1681	>	s := Idx;
1682	>	{$endif}
1683	>	{$endif}
1684	>	for i := 0 to FCount - 1 do
1685	>	if Vars[i].FName = s then
1686	>	begin
1687	>	Result := FXSQLVARs[i];
1688	>	Exit;
1689	>	end;
1690	>	Result := nil;
1691		end;
1692
1693		procedure TIBXSQLDA.Initialize;
1694	+
1695	+	function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1696	+	var
1697	+	k: integer;
1698	+	begin
1699	+	for k := 0 to limit do
1700	+	if FXSQLVARs[k].FName = idx then
1701	+	begin
1702	+	Result := FXSQLVARs[k];
1703	+	Exit;
1704	+	end;
1705	+	Result := nil;
1706	+	end;
1707	+
1708		var
1709		i, j, j_len: Integer;
1439	–	NamesWereEmpty: Boolean;
1710		st: String;
1711		bUnique: Boolean;
1712	+	sBaseName: string;
1713		begin
1714		bUnique := True;
1715	<	NamesWereEmpty := (FNames.Count = 0);
1716	<	if FXSQLDA <> nil then begin
1717	<	for i := 0 to FCount - 1 do begin
1718	<	with FXSQLVARs[i].Data^ do begin
1719	<	if bUnique and (String(relname) <> '') then
1715	>	if FXSQLDA <> nil then
1716	>	begin
1717	>	for i := 0 to FCount - 1 do
1718	>	begin
1719	>	with FXSQLVARs[i].Data^ do
1720	>	begin
1721	>
1722	>	{First get the unique relation name, if any}
1723	>
1724	>	if bUnique and (strpas(relname) <> '') then
1725		begin
1726		if FUniqueRelationName = '' then
1727	<	FUniqueRelationName := String(relname)
1728	<	else if String(relname) <> FUniqueRelationName then
1729	<	begin
1730	<	FUniqueRelationName := '';
1731	<	bUnique := False;
1732	<	end;
1727	>	FUniqueRelationName := strpas(relname)
1728	>	else
1729	>	if strpas(relname) <> FUniqueRelationName then
1730	>	begin
1731	>	FUniqueRelationName := '';
1732	>	bUnique := False;
1733	>	end;
1734		end;
1735	<	if NamesWereEmpty then begin
1736	<	st := String(aliasname);
1737	<	if st = '' then begin
1738	<	st := 'F_'; {do not localize}
1735	>
1736	>	{If an output SQLDA then copy the aliasnames to the FName list. Ensure
1737	>	that they are all upper case only and disambiguated.
1738	>	}
1739	>
1740	>	if not FInputSQLDA then
1741	>	begin
1742	>	st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1743	>	if st = '' then
1744	>	begin
1745	>	sBaseName := 'F_'; {do not localize}
1746		aliasname_length := 2;
1747		j := 1; j_len := 1;
1748	<	StrPCopy(aliasname, st + IntToStr(j));
1749	<	end else begin
1750	<	StrPCopy(aliasname, st);
1748	>	st := sBaseName + IntToStr(j);
1749	>	end
1750	>	else
1751	>	begin
1752		j := 0; j_len := 0;
1753	+	sBaseName := st;
1754		end;
1755	<	while GetXSQLVARByName(String(aliasname)) <> nil do begin
1756	<	Inc(j); j_len := Length(IntToStr(j));
1757	<	if j_len + aliasname_length > 31 then
1758	<	StrPCopy(aliasname,
1759	<	Copy(st, 1, 31 - j_len) +
1760	<	IntToStr(j))
1761	<	else
1762	<	StrPCopy(aliasname, st + IntToStr(j));
1755	>
1756	>	{Look for other columns with the same name and make unique}
1757	>
1758	>	while VarByName(st,i-1) <> nil do
1759	>	begin
1760	>	Inc(j);
1761	>	j_len := Length(IntToStr(j));
1762	>	if j_len + Length(sBaseName) > 31 then
1763	>	st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1764	>	else
1765	>	st := sBaseName + IntToStr(j);
1766		end;
1767	<	Inc(aliasname_length, j_len);
1768	<	AddName(String(aliasname), i);
1767	>
1768	>	FXSQLVARs[i].FName := st;
1769		end;
1770	+
1771	+	{Finally initialise the XSQLVAR}
1772	+
1773	+	FXSQLVARs[i].FIndex := i;
1774	+
1775		case sqltype and (not 1) of
1776		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1777	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1777	>	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1778		SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1779		if (sqllen = 0) then
1780		{ Make sure you get a valid pointer anyway
#	Line 1510 | Line 1804 | var
1804		i, OldSize: Integer;
1805		p : PXSQLVAR;
1806		begin
1513	–	FNames.Clear;
1807		FCount := Value;
1808		if FCount = 0 then
1809		FUniqueRelationName := ''
#	Line 1532 | Line 1825 | begin
1825		FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1826		FXSQLVARs[i].FXSQLVAR := p;
1827		p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1535	–	//        FNames.Add('');
1828		end;
1829		FSize := FCount;
1830		end;
#	Line 1548 | Line 1840 | end;
1840
1841		destructor TIBOutputDelimitedFile.Destroy;
1842		begin
1843	+	{$IFDEF UNIX}
1844	+	if FHandle <> -1 then
1845	+	fpclose(FHandle);
1846	+	{$ELSE}
1847		if FHandle <> 0 then
1848		begin
1849		FlushFileBuffers(FHandle);
1850		CloseHandle(FHandle);
1851		end;
1852	+	{$ENDIF}
1853		inherited Destroy;
1854		end;
1855
1856		procedure TIBOutputDelimitedFile.ReadyFile;
1857		var
1858		i: Integer;
1859	+	{$IFDEF UNIX}
1860	+	BytesWritten: cint;
1861	+	{$ELSE}
1862		BytesWritten: DWORD;
1863	+	{$ENDIF}
1864		st: string;
1865		begin
1866		if FColDelimiter = '' then
1867		FColDelimiter := TAB;
1868		if FRowDelimiter = '' then
1869		FRowDelimiter := CRLF;
1870	+	{$IFDEF UNIX}
1871	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1872	+	{$ELSE}
1873		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1874		FILE_ATTRIBUTE_NORMAL, 0);
1875		if FHandle = INVALID_HANDLE_VALUE then
1876		FHandle := 0;
1877	+	{$ENDIF}
1878		if FOutputTitles then
1879		begin
1880		for i := 0 to Columns.Count - 1 do
1881		if i = 0 then
1882	<	st := string(Columns[i].Data^.aliasname)
1882	>	st := strpas(Columns[i].Data^.aliasname)
1883		else
1884	<	st := st + FColDelimiter + string(Columns[i].Data^.aliasname);
1884	>	st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1885		st := st + FRowDelimiter;
1886	+	{$IFDEF UNIX}
1887	+	if FHandle <> -1 then
1888	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1889	+	if BytesWritten = -1 then
1890	+	raise Exception.Create('File Write Error');
1891	+	{$ELSE}
1892		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1893	+	{$ENDIF}
1894		end;
1895		end;
1896
1897		function TIBOutputDelimitedFile.WriteColumns: Boolean;
1898		var
1899		i: Integer;
1900	+	{$IFDEF UNIX}
1901	+	BytesWritten: cint;
1902	+	{$ELSE}
1903		BytesWritten: DWORD;
1904	+	{$ENDIF}
1905		st: string;
1906		begin
1907		result := False;
1908	+	{$IFDEF UNIX}
1909	+	if FHandle <> -1 then
1910	+	{$ELSE}
1911		if FHandle <> 0 then
1912	+	{$ENDIF}
1913		begin
1914		st := '';
1915		for i := 0 to Columns.Count - 1 do
#	Line 1599 | Line 1919 | begin
1919		st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1920		end;
1921		st := st + FRowDelimiter;
1922	+	{$IFDEF UNIX}
1923	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1924	+	{$ELSE}
1925		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1926	+	{$ENDIF}
1927		if BytesWritten = DWORD(Length(st)) then
1928		result := True;
1929		end
#	Line 1712 | Line 2036 | end;
2036		{ TIBOutputRawFile }
2037		destructor TIBOutputRawFile.Destroy;
2038		begin
2039	+	{$IFDEF UNIX}
2040	+	if FHandle <> -1 then
2041	+	fpclose(FHandle);
2042	+	{$ELSE}
2043		if FHandle <> 0 then
2044		begin
2045		FlushFileBuffers(FHandle);
2046		CloseHandle(FHandle);
2047		end;
2048	+	{$ENDIF}
2049		inherited Destroy;
2050		end;
2051
2052		procedure TIBOutputRawFile.ReadyFile;
2053		begin
2054	+	{$IFDEF UNIX}
2055	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
2056	+	{$ELSE}
2057		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
2058		FILE_ATTRIBUTE_NORMAL, 0);
2059		if FHandle = INVALID_HANDLE_VALUE then
2060		FHandle := 0;
2061	+	{$ENDIF}
2062		end;
2063
2064		function TIBOutputRawFile.WriteColumns: Boolean;
#	Line 1738 | Line 2071 | begin
2071		begin
2072		for i := 0 to Columns.Count - 1 do
2073		begin
2074	+	{$IFDEF UNIX}
2075	+	BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
2076	+	{$ELSE}
2077		WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
2078		BytesWritten, nil);
2079	+	{$ENDIF}
2080		if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
2081		exit;
2082		end;
#	Line 1750 | Line 2087 | end;
2087		{ TIBInputRawFile }
2088		destructor TIBInputRawFile.Destroy;
2089		begin
2090	+	{$IFDEF UNIX}
2091	+	if FHandle <> -1 then
2092	+	fpclose(FHandle);
2093	+	{$ELSE}
2094		if FHandle <> 0 then
2095		CloseHandle(FHandle);
2096	<	inherited;
2096	>	{$ENDIF}
2097	>	inherited Destroy;
2098		end;
2099
2100		function TIBInputRawFile.ReadParameters: Boolean;
#	Line 1761 | Line 2103 | var
2103		BytesRead: DWord;
2104		begin
2105		result := False;
2106	+	{$IFDEF UNIX}
2107	+	if FHandle <> -1 then
2108	+	{$ELSE}
2109		if FHandle <> 0 then
2110	+	{$ENDIF}
2111		begin
2112		for i := 0 to Params.Count - 1 do
2113		begin
2114	+	{$IFDEF UNIX}
2115	+	BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
2116	+	{$ELSE}
2117		ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
2118		BytesRead, nil);
2119	+	{$ENDIF}
2120		if BytesRead <> DWORD(Params[i].Data^.sqllen) then
2121		exit;
2122		end;
#	Line 1776 | Line 2126 | end;
2126
2127		procedure TIBInputRawFile.ReadyFile;
2128		begin
2129	+	{$IFDEF UNIX}
2130	+	if FHandle <> -1 then
2131	+	fpclose(FHandle);
2132	+	FHandle := FpOpen(Filename,O_RdOnly);
2133	+	if FHandle = -1 then
2134	+	raise Exception.CreateFmt('Unable to open file %s',[Filename]);
2135	+	{$ELSE}
2136		if FHandle <> 0 then
2137		CloseHandle(FHandle);
2138		FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
2139		FILE_FLAG_SEQUENTIAL_SCAN, 0);
2140		if FHandle = INVALID_HANDLE_VALUE then
2141		FHandle := 0;
2142	+	{$ENDIF}
2143		end;
2144
2145		{ TIBSQL }
2146		constructor TIBSQL.Create(AOwner: TComponent);
2147	+	var  GUID : TGUID;
2148		begin
2149		inherited Create(AOwner);
2150		FIBLoaded := False;
#	Line 1802 | Line 2161 | begin
2161		FRecordCount := 0;
2162		FSQL := TStringList.Create;
2163		TStringList(FSQL).OnChanging := SQLChanging;
2164	+	TStringList(FSQL).OnChange := SQLChanged;
2165		FProcessedSQL := TStringList.Create;
2166		FHandle := nil;
2167	<	FSQLParams := TIBXSQLDA.Create(self);
2168	<	FSQLRecord := TIBXSQLDA.Create(self);
2167	>	FSQLParams := TIBXSQLDA.Create(self,daInput);
2168	>	FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2169		FSQLType := SQLUnknown;
2170		FParamCheck := True;
2171	<	FCursor := Name + RandomString(8);
2171	>	CreateGuid(GUID);
2172	>	FCursor := GUIDToString(GUID);
2173		if AOwner is TIBDatabase then
2174		Database := TIBDatabase(AOwner)
2175		else
#	Line 1830 | Line 2191 | begin
2191		FSQLParams.Free;
2192		FSQLRecord.Free;
2193		end;
2194	<	inherited;
2194	>	inherited Destroy;
2195		end;
2196
2197		procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
#	Line 1918 | Line 2279 | begin
2279		result := FSQLRecord;
2280		end;
2281
2282	+	function TIBSQL.GetFieldCount: integer;
2283	+	begin
2284	+	Result := FSQLRecord.Count
2285	+	end;
2286	+
2287	+	procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2288	+	begin
2289	+	if FUniqueParamNames = AValue then Exit;
2290	+	FreeHandle;
2291	+	FUniqueParamNames := AValue;
2292	+	end;
2293	+
2294		procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2295		begin
2296		if (FHandle <> nil) then begin
#	Line 1948 | Line 2321 | begin
2321		FBOF := True;
2322		FEOF := False;
2323		FRecordCount := 0;
2324	+	if not (csDesigning in ComponentState) then
2325	+	MonitorHook.SQLExecute(Self);
2326		if FGoToFirstRecordOnExecute then
2327		Next;
2328		end;
#	Line 1957 | Line 2332 | begin
2332		@FHandle,
2333		Database.SQLDialect,
2334		FSQLParams.AsXSQLDA,
2335	<	FSQLRecord.AsXSQLDA), False);
2336	<	if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2335	>	FSQLRecord.AsXSQLDA), True);
2336	>	if not (csDesigning in ComponentState) then
2337	>	MonitorHook.SQLExecute(Self);
2338	>	(*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2339		begin
2340		{ Sometimes a prepared stored procedure appears to get
2341		off sync on the server ....This code is meant to try
#	Line 1973 | Line 2350 | begin
2350		Database.SQLDialect,
2351		FSQLParams.AsXSQLDA,
2352		FSQLRecord.AsXSQLDA), True);
2353	<	end;
2353	>	end;  *)
2354		end
2355		else
2356		Call(isc_dsql_execute(StatusVector,
2357		TRHandle,
2358		@FHandle,
2359		Database.SQLDialect,
2360	<	FSQLParams.AsXSQLDA), True)
2360	>	FSQLParams.AsXSQLDA), True);
2361	>	if not (csDesigning in ComponentState) then
2362	>	MonitorHook.SQLExecute(Self);
2363		end;
2364	<	if not (csDesigning in ComponentState) then
2365	<	MonitorHook.SQLExecute(Self);
2364	>	FBase.DoAfterExecQuery(self);
2365	>	//  writeln('Rows Affected = ',RowsAffected);
2366		end;
2367
2368		function TIBSQL.GetEOF: Boolean;
#	Line 2001 | Line 2380 | begin
2380		result := GetFields(i);
2381		end;
2382
2383	+	function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2384	+	begin
2385	+	Result := Params.ByName(ParamName);
2386	+	end;
2387	+
2388		function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2389		begin
2390		if (Idx < 0) or (Idx >= FSQLRecord.Count) then
#	Line 2090 | Line 2474 | begin
2474		SQLUpdate, SQLDelete])) then
2475		result := ''
2476		else begin
2477	<	info_request := Char(isc_info_sql_get_plan);
2477	>	info_request := isc_info_sql_get_plan;
2478		Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2479		SizeOf(result_buffer), result_buffer), True);
2480	<	if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2480	>	if (result_buffer[0] <> isc_info_sql_get_plan) then
2481		IBError(ibxeUnknownError, [nil]);
2482		result_length := isc_vax_integer(@result_buffer[1], 2);
2483		SetString(result, nil, result_length);
#	Line 2108 | Line 2492 | begin
2492		result := FRecordCount;
2493		end;
2494
2495	<	function TIBSQL.GetRowsAffected: integer;
2495	>	function TIBSQL.GetRowsAffected: Integer;
2496		var
2113	–	result_buffer: array[0..1048] of Char;
2497		info_request: Char;
2498	+	RB: TResultBuffer;
2499		begin
2500		if not Prepared then
2501		result := -1
2502		else begin
2503	<	info_request := Char(isc_info_sql_records);
2504	<	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2505	<	SizeOf(result_buffer), result_buffer) > 0 then
2506	<	IBDatabaseError;
2507	<	if (result_buffer[0] <> Char(isc_info_sql_records)) then
2508	<	result := -1
2509	<	else
2510	<	case SQLType of
2511	<	SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2512	<	SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2513	<	SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2514	<	else         Result := -1 ;
2515	<	end ;
2503	>	RB := TResultBuffer.Create;
2504	>	try
2505	>	info_request := isc_info_sql_records;
2506	>	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2507	>	RB.Size, RB.buffer) > 0 then
2508	>	IBDatabaseError;
2509	>	case SQLType of
2510	>	SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2511	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2512	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2513	>	SQLDelete:
2514	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2515	>	SQLExecProcedure:
2516	>	Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2517	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2518	>	RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2519	>	else
2520	>	Result := 0;
2521	>	end;
2522	>	finally
2523	>	RB.Free;
2524	>	end;
2525		end;
2526		end;
2527
#	Line 2159 | Line 2552 | var
2552		cCurChar, cNextChar, cQuoteChar: Char;
2553		sSQL, sProcessedSQL, sParamName: String;
2554		i, iLenSQL, iSQLPos: Integer;
2555	<	iCurState, iCurParamState: Integer;
2555	>	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2556		iParamSuffix: Integer;
2557		slNames: TStrings;
2558
#	Line 2168 | Line 2561 | const
2561		CommentState = 1;
2562		QuoteState = 2;
2563		ParamState = 3;
2564	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2565		ParamDefaultState = 0;
2566		ParamQuoteState = 1;
2567	+	{$endif}
2568
2569		procedure AddToProcessedSQL(cChar: Char);
2570		begin
#	Line 2178 | Line 2573 | const
2573		end;
2574
2575		begin
2576	+	sParamName := '';
2577		slNames := TStringList.Create;
2578		try
2579		{ Do some initializations of variables }
#	Line 2189 | Line 2585 | begin
2585		i := 1;
2586		iSQLPos := 1;
2587		iCurState := DefaultState;
2588	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2589		iCurParamState := ParamDefaultState;
2590	+	{$endif}
2591		{ Now, traverse through the SQL string, character by character,
2592		picking out the parameters and formatting correctly for InterBase }
2593		while (i <= iLenSQL) do begin
#	Line 2240 | Line 2638 | begin
2638		ParamState:
2639		begin
2640		{ collect the name of the parameter }
2641	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2642		if iCurParamState = ParamDefaultState then
2643		begin
2644		if cCurChar = '"' then
2645		iCurParamState := ParamQuoteState
2646	<	else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2646	>	else
2647	>	{$endif}
2648	>	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2649		sParamName := sParamName + cCurChar
2650		else if FGenerateParamNames then
2651		begin
2652		sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2653		Inc(iParamSuffix);
2654		iCurState := DefaultState;
2655	<	slNames.Add(sParamName);
2655	>	slNames.AddObject(sParamName,self); //Note local convention
2656	>	//add pointer to self to mark entry
2657		sParamName := '';
2658		end
2659		else
2660		IBError(ibxeSQLParseError, [SParamNameExpected]);
2661	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2662		end
2663		else begin
2664		{ determine if Quoted parameter name is finished }
#	Line 2270 | Line 2673 | begin
2673		else
2674		sParamName := sParamName + cCurChar
2675		end;
2676	+	{$endif}
2677		{ determine if the unquoted parameter name is finished }
2678	<	if (iCurParamState <> ParamQuoteState) and
2678	>	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2679		(iCurState <> DefaultState) then
2680		begin
2681		if not (cNextChar in ['A'..'Z', 'a'..'z',
#	Line 2291 | Line 2695 | begin
2695		AddToProcessedSQL(#0);
2696		FSQLParams.Count := slNames.Count;
2697		for i := 0 to slNames.Count - 1 do
2698	<	FSQLParams.AddName(slNames[i], i);
2698	>	FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2699		FProcessedSQL.Text := sProcessedSQL;
2700		finally
2701		slNames.Free;
#	Line 2330 | Line 2734 | begin
2734		{ After preparing the statement, query the stmt type and possibly
2735		create a FSQLRecord "holder" }
2736		{ Get the type of the statement }
2737	<	type_item := Char(isc_info_sql_stmt_type);
2737	>	type_item := isc_info_sql_stmt_type;
2738		Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2739		SizeOf(res_buffer), res_buffer), True);
2740	<	if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2740	>	if (res_buffer[0] <> isc_info_sql_stmt_type) then
2741		IBError(ibxeUnknownError, [nil]);
2742		stmt_len := isc_vax_integer(@res_buffer[1], 2);
2743		FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
#	Line 2378 | Line 2782 | begin
2782		on E: Exception do begin
2783		if (FHandle <> nil) then
2784		FreeHandle;
2785	<	raise;
2785	>	if E is EIBInterBaseError then
2786	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2787	>	EIBInterBaseError(E).IBErrorCode,
2788	>	EIBInterBaseError(E).Message +
2789	>	sSQLErrorSeparator + FProcessedSQL.Text)
2790	>	else
2791	>	raise;
2792		end;
2793		end;
2794		end;
#	Line 2416 | Line 2826 | begin
2826		if FHandle <> nil then FreeHandle;
2827		end;
2828
2829	<	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2829	>	procedure TIBSQL.SQLChanged(Sender: TObject);
2830	>	begin
2831	>	if assigned(OnSQLChanged) then
2832	>	OnSQLChanged(self);
2833	>	end;
2834	>
2835	>	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2836	>	Action: TTransactionAction);
2837		begin
2838		if (FOpen) then
2839		Close;

Diff Legend

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