[ViewVC] Diff of: 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 43 by tony, Thu Sep 22 17:10:15 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	+	{$DEFINE HAS_ANSISTRING_CODEPAGE}
41	+	{$ENDIF}
42	+
43	+	{ IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
44	+
45	+	Dialect 3 quoted format parameter names represent a significant overhead and are of
46	+	limited value - especially for users that use only TIBSQL or TIBCustomDataset
47	+	descendents. They were previously used internally by IBX to simplify SQL generation
48	+	for TTable components in Master/Slave relationships which are linked by
49	+	Dialect 3 names. They were also generated by TStoredProc when the original
50	+	parameter names are quoted.
51	+
52	+	However, for some users they do cause a big processing overhead. The TTable/TStoredProc
53	+	code has been re-written so that they are no required by IBX internally.
54	+	The code to support quoted parameter names is now subject to conditional compilation.
55	+	To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled.
56	+
57	+	Hint: deleting the space between the brace and the dollar sign below
58	+
59	+	}
60	+
61	+	{ $define ALLOWDIALECT3PARAMNAMES}
62	+
63	+	{$ifndef ALLOWDIALECT3PARAMNAMES}
64	+
65	+	{ Even when dialect 3 quoted format parameter names are not supported, IBX still processes
66	+	parameter names case insensitive. This does result in some additional overhead
67	+	due to a call to "AnsiUpperCase". This can be avoided by undefining
68	+	"UseCaseSensitiveParamName" below.
69	+
70	+	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
71	+	is defined. This will not give a useful result.
72	+	}
73	+	{$define UseCaseSensitiveParamName}
74	+	{$endif}
75	+
76		interface
77
78		uses
79	<	Windows, SysUtils, Classes, Forms, Controls, IBHeader,
79	>	{$IFDEF WINDOWS }
80	>	Windows,
81	>	{$ELSE}
82	>	baseunix, unix,
83	>	{$ENDIF}
84	>	SysUtils, Classes, IBHeader,
85		IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
86
87	+	const
88	+	sSQLErrorSeparator = ' When Executing: ';
89	+
90		type
91		TIBSQL = class;
92		TIBXSQLDA = class;
#	Line 44 \| Line 97 \| type
97		FParent: TIBXSQLDA;
98		FSQL: TIBSQL;
99		FIndex: Integer;
100	+	FCharSetID: integer;
101		FModified: Boolean;
102		FName: String;
103	+	FUniqueName: boolean;
104		FXSQLVAR: PXSQLVAR; { Point to the PXSQLVAR in the owner object }
105
106		function AdjustScale(Value: Int64; Scale: Integer): Double;
107		function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
108		function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
109	+	function GetAsBoolean: boolean;
110		function GetAsCurrency: Currency;
111		function GetAsInt64: Int64;
112		function GetAsDateTime: TDateTime;
#	Line 67 \| Line 123 \| type
123		function GetIsNullable: Boolean;
124		function GetSize: Integer;
125		function GetSQLType: Integer;
126	+	procedure SetAsBoolean(AValue: boolean);
127		procedure SetAsCurrency(Value: Currency);
128		procedure SetAsInt64(Value: Int64);
129		procedure SetAsDate(Value: TDateTime);
130	+	procedure SetAsLong(Value: Long);
131		procedure SetAsTime(Value: TDateTime);
132		procedure SetAsDateTime(Value: TDateTime);
133		procedure SetAsDouble(Value: Double);
134		procedure SetAsFloat(Value: Float);
77	–	procedure SetAsLong(Value: Long);
135		procedure SetAsPointer(Value: Pointer);
136		procedure SetAsQuad(Value: TISC_QUAD);
137		procedure SetAsShort(Value: Short);
#	Line 83 \| Line 140 \| type
140		procedure SetAsXSQLVAR(Value: PXSQLVAR);
141		procedure SetIsNull(Value: Boolean);
142		procedure SetIsNullable(Value: Boolean);
143	+	procedure xSetAsBoolean(AValue: boolean);
144	+	procedure xSetAsCurrency(Value: Currency);
145	+	procedure xSetAsInt64(Value: Int64);
146	+	procedure xSetAsDate(Value: TDateTime);
147	+	procedure xSetAsTime(Value: TDateTime);
148	+	procedure xSetAsDateTime(Value: TDateTime);
149	+	procedure xSetAsDouble(Value: Double);
150	+	procedure xSetAsFloat(Value: Float);
151	+	procedure xSetAsLong(Value: Long);
152	+	procedure xSetAsPointer(Value: Pointer);
153	+	procedure xSetAsQuad(Value: TISC_QUAD);
154	+	procedure xSetAsShort(Value: Short);
155	+	procedure xSetAsString(Value: String);
156	+	procedure xSetAsVariant(Value: Variant);
157	+	procedure xSetAsXSQLVAR(Value: PXSQLVAR);
158	+	procedure xSetIsNull(Value: Boolean);
159	+	procedure xSetIsNullable(Value: Boolean);
160		public
161		constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
162		procedure Assign(Source: TIBXSQLVAR);
163	+	procedure Clear;
164	+	function GetCharSetID: integer;
165	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
166	+	function GetCodePage: TSystemCodePage;
167	+	{$ENDIF}
168		procedure LoadFromFile(const FileName: String);
169		procedure LoadFromStream(Stream: TStream);
170		procedure SaveToFile(const FileName: String);
171		procedure SaveToStream(Stream: TStream);
172		property AsDate: TDateTime read GetAsDateTime write SetAsDate;
173	+	property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
174		property AsTime: TDateTime read GetAsDateTime write SetAsTime;
175		property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
176		property AsDouble: Double read GetAsDouble write SetAsDouble;
#	Line 118 \| Line 198 \| type
198
199		TIBXSQLVARArray = Array of TIBXSQLVAR;
200
201	<	{ TIBXSQLVAR }
201	>	TIBXSQLDAType = (daInput,daOutput);
202	>
203	>	{ TIBXSQLDA }
204	>
205		TIBXSQLDA = class(TObject)
206		protected
207		FSQL: TIBSQL;
208		FCount: Integer;
126	–	FNames: TStrings;
209		FSize: Integer;
210	+	FInputSQLDA: boolean;
211		FXSQLDA: PXSQLDA;
212		FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
213		FUniqueRelationName: String;
214		function GetModified: Boolean;
132	–	function GetNames: String;
215		function GetRecordSize: Integer;
216		function GetXSQLDA: PXSQLDA;
217		function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
#	Line 137 \| Line 219 \| type
219		procedure Initialize;
220		procedure SetCount(Value: Integer);
221		public
222	<	constructor Create(Query: TIBSQL);
222	>	constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
223		destructor Destroy; override;
224	<	procedure AddName(FieldName: String; Idx: Integer);
224	>	procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
225		function ByName(Idx: String): TIBXSQLVAR;
226		property AsXSQLDA: PXSQLDA read GetXSQLDA;
227		property Count: Integer read FCount write SetCount;
228		property Modified: Boolean read GetModified;
147	–	property Names: String read GetNames;
229		property RecordSize: Integer read GetRecordSize;
230		property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
231		property UniqueRelationName: String read FUniqueRelationName;
#	Line 178 \| Line 259 \| type
259		{ TIBOutputDelimitedFile }
260		TIBOutputDelimitedFile = class(TIBBatchOutput)
261		protected
262	+	{$IFDEF UNIX}
263	+	FHandle: cint;
264	+	{$ELSE}
265		FHandle: THandle;
266	+	{$ENDIF}
267		FOutputTitles: Boolean;
268		FColDelimiter,
269		FRowDelimiter: string;
#	Line 217 \| Line 302 \| type
302		{ TIBOutputRawFile }
303		TIBOutputRawFile = class(TIBBatchOutput)
304		protected
305	+	{$IFDEF UNIX}
306	+	FHandle: cint;
307	+	{$ELSE}
308		FHandle: THandle;
309	+	{$ENDIF}
310		public
311		destructor Destroy; override;
312		procedure ReadyFile; override;
#	Line 227 \| Line 316 \| type
316		{ TIBInputRawFile }
317		TIBInputRawFile = class(TIBBatchInput)
318		protected
319	+	{$IFDEF UNIX}
320	+	FHandle: cint;
321	+	{$ELSE}
322		FHandle: THandle;
323	+	{$ENDIF}
324		public
325		destructor Destroy; override;
326		function ReadParameters: Boolean; override;
#	Line 245 \| Line 338 \| type
338		TIBSQL = class(TComponent)
339		private
340		FIBLoaded: Boolean;
341	+	FOnSQLChanged: TNotifyEvent;
342	+	FUniqueParamNames: Boolean;
343	+	function GetFieldCount: integer;
344	+	procedure SetUniqueParamNames(AValue: Boolean);
345		protected
346		FBase: TIBBase;
347		FBOF, { At BOF? }
#	Line 280 \| Line 377 \| type
377		procedure SetSQL(Value: TStrings);
378		procedure SetTransaction(Value: TIBTransaction);
379		procedure SQLChanging(Sender: TObject);
380	<	procedure BeforeTransactionEnd(Sender: TObject);
380	>	procedure SQLChanged(Sender: TObject);
381	>	procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
382		public
383		constructor Create(AOwner: TComponent); override;
384		destructor Destroy; override;
#	Line 294 \| Line 392 \| type
392		function Current: TIBXSQLDA;
393		procedure ExecQuery;
394		function FieldByName(FieldName: String): TIBXSQLVAR;
395	+	function ParamByName(ParamName: String): TIBXSQLVAR;
396		procedure FreeHandle;
397		function Next: TIBXSQLDA;
398		procedure Prepare;
#	Line 303 \| Line 402 \| type
402		property Eof: Boolean read GetEOF;
403		property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
404		property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
405	+	property FieldCount: integer read GetFieldCount;
406		property Open: Boolean read FOpen;
407		property Params: TIBXSQLDA read GetSQLParams;
408		property Plan: String read GetPlan;
#	Line 312 \| Line 412 \| type
412		property SQLType: TIBSQLTypes read FSQLType;
413		property TRHandle: PISC_TR_HANDLE read GetTRHandle;
414		property Handle: TISC_STMT_HANDLE read FHandle;
315	–	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
415		property UniqueRelationName: String read GetUniqueRelationName;
416		published
417		property Database: TIBDatabase read GetDatabase write SetDatabase;
418	+	property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
419	+	property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
420		property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
421		write FGoToFirstRecordOnExecute
422		default True;
#	Line 323 \| Line 424 \| type
424		property SQL: TStrings read FSQL write SetSQL;
425		property Transaction: TIBTransaction read GetTransaction write SetTransaction;
426		property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
427	+	property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
428		end;
429
430		implementation
431
432		uses
433	<	IBIntf, IBBlob, IBSQLMonitor;
433	>	IBIntf, IBBlob, Variants , IBSQLMonitor, IBCodePage;
434
435		{ TIBXSQLVAR }
436		constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
#	Line 343 \| Line 445 \| var
445		szBuff: PChar;
446		s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
447		bSourceBlob, bDestBlob: Boolean;
448	<	iSegs, iMaxSeg, iSize: Long;
448	>	iSegs: Int64;
449	>	iMaxSeg: Int64;
450	>	iSize: Int64;
451		iBlobType: Short;
452		begin
453		szBuff := nil;
#	Line 405 \| Line 509 \| begin
509		0, nil), True);
510		try
511		IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
512	+	isNull := false
513		finally
514		FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
515		end;
#	Line 424 \| Line 529 \| end;
529
530		function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
531		var
532	<	Scaling, i: Integer;
532	>	Scaling : Int64;
533	>	i: Integer;
534		Val: Double;
535		begin
536		Scaling := 1; Val := Value;
#	Line 447 \| Line 553 \| end;
553
554		function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
555		var
556	<	Scaling, i: Integer;
556	>	Scaling : Int64;
557	>	i: Integer;
558		Val: Int64;
559		begin
560		Scaling := 1; Val := Value;
#	Line 463 \| Line 570 \| end;
570
571		function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
572		var
573	<	Scaling, i : Integer;
573	>	Scaling : Int64;
574	>	i : Integer;
575		FractionText, PadText, CurrText: string;
576		begin
577	<	result := Value;
577	>	Result := 0;
578		Scaling := 1;
579		if Scale > 0 then
580		begin
#	Line 489 \| Line 597 \| begin
597		try
598		result := StrToCurr(CurrText);
599		except
600	<	on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
600	>	on E: Exception do
601	>	IBError(ibxeInvalidDataConversion, [nil]);
602		end;
603	<	end;
603	>	end
604	>	else
605	>	result := Value;
606	>	end;
607	>
608	>	function TIBXSQLVAR.GetAsBoolean: boolean;
609	>	begin
610	>	result := false;
611	>	if not IsNull then
612	>	begin
613	>	if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
614	>	result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
615	>	else
616	>	IBError(ibxeInvalidDataConversion, [nil]);
617	>	end
618		end;
619
620		function TIBXSQLVAR.GetAsCurrency: Currency;
#	Line 557 \| Line 680 \| end;
680		function TIBXSQLVAR.GetAsDateTime: TDateTime;
681		var
682		tm_date: TCTimeStructure;
683	+	msecs: word;
684		begin
685		result := 0;
686		if not IsNull then
#	Line 582 \| Line 706 \| begin
706		SQL_TYPE_TIME: begin
707		isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
708		try
709	+	msecs := (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
710		result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
711	<	Word(tm_date.tm_sec), 0)
711	>	Word(tm_date.tm_sec), msecs)
712		except
713		on E: EConvertError do begin
714		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 595 \| Line 720 \| begin
720		try
721		result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
722		Word(tm_date.tm_mday));
723	+	msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
724		if result >= 0 then
725		result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
726	<	Word(tm_date.tm_sec), 0)
726	>	Word(tm_date.tm_sec), msecs)
727		else
728		result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
729	<	Word(tm_date.tm_sec), 0)
729	>	Word(tm_date.tm_sec), msecs)
730		except
731		on E: EConvertError do begin
732		IBError(ibxeInvalidDataConversion, [nil]);
#	Line 721 \| Line 847 \| var
847		sz: PChar;
848		str_len: Integer;
849		ss: TStringStream;
850	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
851	+	rs: RawByteString;
852	+	{$ENDIF}
853		begin
854		result := '';
855		{ Check null, if so return a default string }
#	Line 730 \| Line 859 \| begin
859		result := '(Array)'; {do not localize}
860		SQL_BLOB: begin
861		ss := TStringStream.Create('');
862	<	SaveToStream(ss);
863	<	result := ss.DataString;
864	<	ss.Free;
862	>	try
863	>	SaveToStream(ss);
864	>	{$IFDEF HAS_ANSISTRING_CODEPAGE}
865	>	rs := ss.DataString;
866	>	SetCodePage(rs,GetCodePage,false);
867	>	result := rs;
868	>	{$ELSE}
869	>	result := ss.DataString;
870	>	{$ENDIF}
871	>	finally
872	>	ss.Free;
873	>	end;
874		end;
875		SQL_TEXT, SQL_VARYING: begin
876		sz := FXSQLVAR^.sqldata;
#	Line 742 \| Line 880 \| begin
880		str_len := isc_vax_integer(FXSQLVar^.sqldata, 2);
881		Inc(sz, 2);
882		end;
883	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
884	+	SetString(rs, sz, str_len);
885	+	SetCodePage(rs,GetCodePage,false);
886	+	result := rs;
887	+	{$ELSE}
888		SetString(result, sz, str_len);
889	+	{$ENDIF}
890		if ((FXSQLVar^.sqltype and (not 1)) = SQL_TEXT) then
891		result := TrimRight(result);
892		end;
#	Line 799 \| Line 943 \| begin
943		result := AsDouble;
944		SQL_INT64:
945		if FXSQLVAR^.sqlscale = 0 then
946	<	IBError(ibxeInvalidDataConversion, [nil])
946	>	result := AsInt64
947		else if FXSQLVAR^.sqlscale >= (-4) then
948		result := AsCurrency
949		else
950		result := AsDouble;
951		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
952		result := AsDouble;
953	+	SQL_BOOLEAN:
954	+	result := AsBoolean;
955		else
956		IBError(ibxeInvalidDataConversion, [nil]);
957		end;
#	Line 894 \| Line 1040 \| begin
1040		result := FXSQLVAR^.sqltype and (not 1);
1041		end;
1042
1043	+	procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1044	+	var
1045	+	i: Integer;
1046	+	begin
1047	+	if FUniqueName then
1048	+	xSetAsBoolean(AValue)
1049	+	else
1050	+	for i := 0 to FParent.FCount - 1 do
1051	+	if FParent[i].FName = FName then
1052	+	FParent[i].xSetAsBoolean(AValue);
1053	+	end;
1054	+
1055	+	procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1056	+	begin
1057	+	if IsNullable then
1058	+	IsNull := False;
1059	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1060	+	FXSQLVAR^.sqlscale := -4;
1061	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1062	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1063	+	PCurrency(FXSQLVAR^.sqldata)^ := Value;
1064	+	FModified := True;
1065	+	end;
1066	+
1067		procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1068		var
899	–	xvar: TIBXSQLVAR;
1069		i: Integer;
1070		begin
1071		if FSQL.Database.SQLDialect < 3 then
1072		AsDouble := Value
1073		else
1074		begin
1075	<	if IsNullable then
1076	<	IsNull := False;
1075	>
1076	>	if FUniqueName then
1077	>	xSetAsCurrency(Value)
1078	>	else
1079		for i := 0 to FParent.FCount - 1 do
1080	<	if FParent.FNames[i] = FName then
1081	<	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;
1080	>	if FParent[i].FName = FName then
1081	>	FParent[i].xSetAsCurrency(Value);
1082		end;
1083		end;
1084
1085	+	procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1086	+	begin
1087	+	if IsNullable then
1088	+	IsNull := False;
1089	+
1090	+	FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1091	+	FXSQLVAR^.sqlscale := 0;
1092	+	FXSQLVAR^.sqllen := SizeOf(Int64);
1093	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1094	+	PInt64(FXSQLVAR^.sqldata)^ := Value;
1095	+	FModified := True;
1096	+	end;
1097	+
1098		procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1099		var
1100		i: Integer;
1101	<	xvar: TIBXSQLVAR;
1101	>	begin
1102	>	if FUniqueName then
1103	>	xSetAsInt64(Value)
1104	>	else
1105	>	for i := 0 to FParent.FCount - 1 do
1106	>	if FParent[i].FName = FName then
1107	>	FParent[i].xSetAsInt64(Value);
1108	>	end;
1109	>
1110	>	procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1111	>	var
1112	>	tm_date: TCTimeStructure;
1113	>	Yr, Mn, Dy: Word;
1114		begin
1115		if IsNullable then
1116		IsNull := False;
1117	<	for i := 0 to FParent.FCount - 1 do
1118	<	if FParent.FNames[i] = FName then
1119	<	begin
1120	<	xvar := FParent[i];
1121	<	xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1122	<	xvar.FXSQLVAR^.sqlscale := 0;
1123	<	xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1124	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1125	<	PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1126	<	xvar.FModified := True;
1127	<	end;
1117	>
1118	>	FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1119	>	DecodeDate(Value, Yr, Mn, Dy);
1120	>	with tm_date do begin
1121	>	tm_sec := 0;
1122	>	tm_min := 0;
1123	>	tm_hour := 0;
1124	>	tm_mday := Dy;
1125	>	tm_mon := Mn - 1;
1126	>	tm_year := Yr - 1900;
1127	>	end;
1128	>	FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1129	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1130	>	isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1131	>	FModified := True;
1132		end;
1133
1134		procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1135		var
1136		i: Integer;
945	–	tm_date: TCTimeStructure;
946	–	Yr, Mn, Dy: Word;
947	–	xvar: TIBXSQLVAR;
1137		begin
1138		if FSQL.Database.SQLDialect < 3 then
1139		begin
1140		AsDateTime := Value;
1141		exit;
1142		end;
1143	+
1144	+	if FUniqueName then
1145	+	xSetAsDate(Value)
1146	+	else
1147	+	for i := 0 to FParent.FCount - 1 do
1148	+	if FParent[i].FName = FName then
1149	+	FParent[i].xSetAsDate(Value);
1150	+	end;
1151	+
1152	+	procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1153	+	var
1154	+	tm_date: TCTimeStructure;
1155	+	Hr, Mt, S, Ms: Word;
1156	+	begin
1157		if IsNullable then
1158		IsNull := False;
1159	<	for i := 0 to FParent.FCount - 1 do
1160	<	if FParent.FNames[i] = FName then
1161	<	begin
1162	<	xvar := FParent[i];
1163	<	xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1164	<	DecodeDate(Value, Yr, Mn, Dy);
1165	<	with tm_date do begin
1166	<	tm_sec := 0;
1167	<	tm_min := 0;
1168	<	tm_hour := 0;
1169	<	tm_mday := Dy;
1170	<	tm_mon := Mn - 1;
1171	<	tm_year := Yr - 1900;
1172	<	end;
1173	<	xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1174	<	IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1175	<	isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
973	<	xvar.FModified := True;
974	<	end;
1159	>
1160	>	FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1161	>	DecodeTime(Value, Hr, Mt, S, Ms);
1162	>	with tm_date do begin
1163	>	tm_sec := S;
1164	>	tm_min := Mt;
1165	>	tm_hour := Hr;
1166	>	tm_mday := 0;
1167	>	tm_mon := 0;
1168	>	tm_year := 0;
1169	>	end;
1170	>	FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1171	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1172	>	isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1173	>	if Ms > 0 then
1174	>	Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1175	>	FModified := True;
1176		end;
1177
1178		procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1179		var
1180		i: Integer;
980	–	tm_date: TCTimeStructure;
981	–	Hr, Mt, S, Ms: Word;
982	–	xvar: TIBXSQLVAR;
1181		begin
1182		if FSQL.Database.SQLDialect < 3 then
1183		begin
1184		AsDateTime := Value;
1185		exit;
1186		end;
1187	<	if IsNullable then
1188	<	IsNull := False;
1187	>
1188	>	if FUniqueName then
1189	>	xSetAsTime(Value)
1190	>	else
1191		for i := 0 to FParent.FCount - 1 do
1192	<	if FParent.FNames[i] = FName then
1193	<	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;
1192	>	if FParent[i].FName = FName then
1193	>	FParent[i].xSetAsTime(Value);
1194		end;
1195
1196	<	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1196	>	procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1197		var
1014	–	i: Integer;
1198		tm_date: TCTimeStructure;
1199		Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1017	–	xvar: TIBXSQLVAR;
1200		begin
1201		if IsNullable then
1202		IsNull := False;
1203	+
1204	+	FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1205	+	DecodeDate(Value, Yr, Mn, Dy);
1206	+	DecodeTime(Value, Hr, Mt, S, Ms);
1207	+	with tm_date do begin
1208	+	tm_sec := S;
1209	+	tm_min := Mt;
1210	+	tm_hour := Hr;
1211	+	tm_mday := Dy;
1212	+	tm_mon := Mn - 1;
1213	+	tm_year := Yr - 1900;
1214	+	end;
1215	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1216	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1217	+	isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1218	+	if Ms > 0 then
1219	+	Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1220	+	FModified := True;
1221	+	end;
1222	+
1223	+	procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1224	+	var
1225	+	i: Integer;
1226	+	begin
1227	+	if FUniqueName then
1228	+	xSetAsDateTime(value)
1229	+	else
1230		for i := 0 to FParent.FCount - 1 do
1231	<	if FParent.FNames[i] = FName then
1232	<	begin
1233	<	xvar := FParent[i];
1234	<	xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1235	<	DecodeDate(Value, Yr, Mn, Dy);
1236	<	DecodeTime(Value, Hr, Mt, S, Ms);
1237	<	with tm_date do begin
1238	<	tm_sec := S;
1239	<	tm_min := Mt;
1240	<	tm_hour := Hr;
1241	<	tm_mday := Dy;
1242	<	tm_mon := Mn - 1;
1243	<	tm_year := Yr - 1900;
1244	<	end;
1245	<	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;
1231	>	if FParent[i].FName = FName then
1232	>	FParent[i].xSetAsDateTime(Value);
1233	>	end;
1234	>
1235	>	procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1236	>	begin
1237	>	if IsNullable then
1238	>	IsNull := False;
1239	>
1240	>	FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1241	>	FXSQLVAR^.sqllen := SizeOf(Double);
1242	>	FXSQLVAR^.sqlscale := 0;
1243	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1244	>	PDouble(FXSQLVAR^.sqldata)^ := Value;
1245	>	FModified := True;
1246		end;
1247
1248		procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1249		var
1250		i: Integer;
1251	<	xvar: TIBXSQLVAR;
1251	>	begin
1252	>	if FUniqueName then
1253	>	xSetAsDouble(Value)
1254	>	else
1255	>	for i := 0 to FParent.FCount - 1 do
1256	>	if FParent[i].FName = FName then
1257	>	FParent[i].xSetAsDouble(Value);
1258	>	end;
1259	>
1260	>	procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
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_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1269	<	xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1270	<	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;
1264	>
1265	>	FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1266	>	FXSQLVAR^.sqllen := SizeOf(Float);
1267	>	FXSQLVAR^.sqlscale := 0;
1268	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1269	>	PSingle(FXSQLVAR^.sqldata)^ := Value;
1270	>	FModified := True;
1271		end;
1272
1273		procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1274		var
1275		i: Integer;
1276	<	xvar: TIBXSQLVAR;
1276	>	begin
1277	>	if FUniqueName then
1278	>	xSetAsFloat(Value)
1279	>	else
1280	>	for i := 0 to FParent.FCount - 1 do
1281	>	if FParent[i].FName = FName then
1282	>	FParent[i].xSetAsFloat(Value);
1283	>	end;
1284	>
1285	>	procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1286		begin
1287		if IsNullable then
1288		IsNull := False;
1289	<	for i := 0 to FParent.FCount - 1 do
1290	<	if FParent.FNames[i] = FName then
1291	<	begin
1292	<	xvar := FParent[i];
1293	<	xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1294	<	xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1295	<	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;
1289	>
1290	>	FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1291	>	FXSQLVAR^.sqllen := SizeOf(Long);
1292	>	FXSQLVAR^.sqlscale := 0;
1293	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1294	>	PLong(FXSQLVAR^.sqldata)^ := Value;
1295	>	FModified := True;
1296		end;
1297
1298		procedure TIBXSQLVAR.SetAsLong(Value: Long);
1299		var
1300		i: Integer;
1086	–	xvar: TIBXSQLVAR;
1301		begin
1302	<	if IsNullable then
1303	<	IsNull := False;
1302	>	if FUniqueName then
1303	>	xSetAsLong(Value)
1304	>	else
1305		for i := 0 to FParent.FCount - 1 do
1306	<	if FParent.FNames[i] = FName then
1307	<	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;
1306	>	if FParent[i].FName = FName then
1307	>	FParent[i].xSetAsLong(Value);
1308		end;
1309
1310	<	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1104	<	var
1105	<	i: Integer;
1106	<	xvar: TIBXSQLVAR;
1310	>	procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1311		begin
1312		if IsNullable and (Value = nil) then
1313		IsNull := True
1314		else begin
1315		IsNull := False;
1316	<	for i := 0 to FParent.FCount - 1 do
1317	<	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;
1316	>	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1317	>	Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1318		end;
1319	+	FModified := True;
1320	+	end;
1321	+
1322	+	procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1323	+	var
1324	+	i: Integer;
1325	+	begin
1326	+	if FUniqueName then
1327	+	xSetAsPointer(Value)
1328	+	else
1329	+	for i := 0 to FParent.FCount - 1 do
1330	+	if FParent[i].FName = FName then
1331	+	FParent[i].xSetAsPointer(Value);
1332	+	end;
1333	+
1334	+	procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1335	+	begin
1336	+	if IsNullable then
1337	+	IsNull := False;
1338	+	if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1339	+	(FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1340	+	IBError(ibxeInvalidDataConversion, [nil]);
1341	+	FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1342	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1343	+	PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1344	+	FModified := True;
1345		end;
1346
1347		procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1348		var
1349		i: Integer;
1350	<	xvar: TIBXSQLVAR;
1350	>	begin
1351	>	if FUniqueName then
1352	>	xSetAsQuad(Value)
1353	>	else
1354	>	for i := 0 to FParent.FCount - 1 do
1355	>	if FParent[i].FName = FName then
1356	>	FParent[i].xSetAsQuad(Value);
1357	>	end;
1358	>
1359	>	procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1360		begin
1361		if IsNullable then
1362		IsNull := False;
1363	<	for i := 0 to FParent.FCount - 1 do
1364	<	if FParent.FNames[i] = FName then
1365	<	begin
1366	<	xvar := FParent[i];
1367	<	if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1368	<	(xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1369	<	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;
1363	>
1364	>	FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1365	>	FXSQLVAR^.sqllen := SizeOf(Short);
1366	>	FXSQLVAR^.sqlscale := 0;
1367	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1368	>	PShort(FXSQLVAR^.sqldata)^ := Value;
1369	>	FModified := True;
1370		end;
1371
1372		procedure TIBXSQLVAR.SetAsShort(Value: Short);
1373		var
1374		i: Integer;
1147	–	xvar: TIBXSQLVAR;
1375		begin
1376	<	if IsNullable then
1377	<	IsNull := False;
1376	>	if FUniqueName then
1377	>	xSetAsShort(Value)
1378	>	else
1379		for i := 0 to FParent.FCount - 1 do
1380	<	if FParent.FNames[i] = FName then
1381	<	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;
1380	>	if FParent[i].FName = FName then
1381	>	FParent[i].xSetAsShort(Value);
1382		end;
1383
1384	<	procedure TIBXSQLVAR.SetAsString(Value: String);
1384	>	procedure TIBXSQLVAR.xSetAsString(Value: String);
1385		var
1386	<	stype: Integer;
1387	<	ss: TStringStream;
1168	<
1169	<	procedure SetStringValue;
1170	<	var
1171	<	i: Integer;
1172	<	xvar: TIBXSQLVAR;
1173	<	begin
1174	<	for i := 0 to FParent.FCount - 1 do
1175	<	if FParent.FNames[i] = FName then
1176	<	begin
1177	<	xvar := FParent[i];
1178	<	if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1179	<	(xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1180	<	Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1181	<	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;
1189	<	end;
1190	<	end;
1386	>	stype: Integer;
1387	>	ss: TStringStream;
1388
1389	+	procedure SetStringValue;
1390	+	var
1391	+	i: Integer;
1392	+	begin
1393	+	if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1394	+	(FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1395	+	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1396	+	else begin
1397	+	FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1398	+	FXSQLVAR^.sqllen := Length(Value);
1399	+	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1400	+	if (Length(Value) > 0) then
1401	+	Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1402	+	end;
1403	+	FModified := True;
1404	+	end;
1405	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1406	+	var rs: RawByteString;
1407	+	codepage: TSystemCodePage;
1408	+	{$ENDIF}
1409		begin
1410		if IsNullable then
1411		IsNull := False;
1412	+
1413		stype := FXSQLVAR^.sqltype and (not 1);
1414	+
1415	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1416	+	codepage := GetCodePage;
1417	+	if (codepage <> CP_NONE) and (StringCodePage(Value) <> codepage) then
1418	+	begin
1419	+	rs := Value;
1420	+	SetCodePage(rs,codepage,true);
1421	+	Value := rs;
1422	+	end;
1423	+	{$ENDIF}
1424	+
1425		if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1426		SetStringValue
1427		else begin
#	Line 1209 \| Line 1438 \| begin
1438		IsNull := True
1439		else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1440		(stype = SQL_TYPE_TIME) then
1441	<	SetAsDateTime(StrToDateTime(Value))
1441	>	xSetAsDateTime(StrToDateTime(Value))
1442		else
1443		SetStringValue;
1444		end;
1445		end;
1446
1447	<	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1447	>	procedure TIBXSQLVAR.SetAsString(Value: String);
1448	>	var
1449	>	i: integer;
1450	>	begin
1451	>	if FUniqueName then
1452	>	xSetAsString(Value)
1453	>	else
1454	>	for i := 0 to FParent.FCount - 1 do
1455	>	if FParent[i].FName = FName then
1456	>	FParent[i].xSetAsString(Value);
1457	>	end;
1458	>
1459	>	procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1460		begin
1461		if VarIsNull(Value) then
1462		IsNull := True
1463		else case VarType(Value) of
1464		varEmpty, varNull:
1465		IsNull := True;
1466	<	varSmallint, varInteger, varByte:
1466	>	varSmallint, varInteger, varByte,
1467	>	varWord, varShortInt:
1468		AsLong := Value;
1469	+	varInt64:
1470	+	AsInt64 := Value;
1471		varSingle, varDouble:
1472		AsDouble := Value;
1473		varCurrency:
1474		AsCurrency := Value;
1475		varBoolean:
1476	<	if Value then
1233	<	AsLong := ISC_TRUE
1234	<	else
1235	<	AsLong := ISC_FALSE;
1476	>	AsBoolean := Value;
1477		varDate:
1478		AsDateTime := Value;
1479		varOleStr, varString:
#	Line 1244 \| Line 1485 \| begin
1485		end;
1486		end;
1487
1488	<	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1488	>	procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1489	>	var
1490	>	i: integer;
1491	>	begin
1492	>	if FUniqueName then
1493	>	xSetAsVariant(Value)
1494	>	else
1495	>	for i := 0 to FParent.FCount - 1 do
1496	>	if FParent[i].FName = FName then
1497	>	FParent[i].xSetAsVariant(Value);
1498	>	end;
1499	>
1500	>	procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1501		var
1249	–	i: Integer;
1250	–	xvar: TIBXSQLVAR;
1502		sqlind: PShort;
1503		sqldata: PChar;
1504		local_sqllen: Integer;
1505		begin
1506	<	for i := 0 to FParent.FCount - 1 do
1507	<	if FParent.FNames[i] = FName then
1508	<	begin
1509	<	xvar := FParent[i];
1510	<	sqlind := xvar.FXSQLVAR^.sqlind;
1511	<	sqldata := xvar.FXSQLVAR^.sqldata;
1512	<	Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1513	<	xvar.FXSQLVAR^.sqlind := sqlind;
1514	<	xvar.FXSQLVAR^.sqldata := sqldata;
1515	<	if (Value^.sqltype and 1 = 1) then
1516	<	begin
1517	<	if (xvar.FXSQLVAR^.sqlind = nil) then
1518	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1519	<	xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1520	<	end
1521	<	else
1522	<	if (xvar.FXSQLVAR^.sqlind <> nil) then
1523	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1524	<	if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1525	<	local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1526	<	else
1527	<	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;
1506	>	sqlind := FXSQLVAR^.sqlind;
1507	>	sqldata := FXSQLVAR^.sqldata;
1508	>	Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1509	>	FXSQLVAR^.sqlind := sqlind;
1510	>	FXSQLVAR^.sqldata := sqldata;
1511	>	if (Value^.sqltype and 1 = 1) then
1512	>	begin
1513	>	if (FXSQLVAR^.sqlind = nil) then
1514	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1515	>	FXSQLVAR^.sqlind^ := Value^.sqlind^;
1516	>	end
1517	>	else
1518	>	if (FXSQLVAR^.sqlind <> nil) then
1519	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1520	>	if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1521	>	local_sqllen := FXSQLVAR^.sqllen + 2
1522	>	else
1523	>	local_sqllen := FXSQLVAR^.sqllen;
1524	>	FXSQLVAR^.sqlscale := Value^.sqlscale;
1525	>	IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1526	>	Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1527	>	FModified := True;
1528		end;
1529
1530	<	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1530	>	procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1531		var
1532		i: Integer;
1533	<	xvar: TIBXSQLVAR;
1533	>	begin
1534	>	if FUniqueName then
1535	>	xSetAsXSQLVAR(Value)
1536	>	else
1537	>	for i := 0 to FParent.FCount - 1 do
1538	>	if FParent[i].FName = FName then
1539	>	FParent[i].xSetAsXSQLVAR(Value);
1540	>	end;
1541	>
1542	>	procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1543		begin
1544		if Value then
1545		begin
1546		if not IsNullable then
1547		IsNullable := True;
1548	<	for i := 0 to FParent.FCount - 1 do
1549	<	if FParent.FNames[i] = FName then
1550	<	begin
1551	<	xvar := FParent[i];
1552	<	xvar.FXSQLVAR^.sqlind^ := -1;
1553	<	xvar.FModified := True;
1554	<	end;
1555	<	end else if ((not Value) and IsNullable) then
1548	>
1549	>	if Assigned(FXSQLVAR^.sqlind) then
1550	>	FXSQLVAR^.sqlind^ := -1;
1551	>	FModified := True;
1552	>	end
1553	>	else
1554	>	if ((not Value) and IsNullable) then
1555	>	begin
1556	>	if Assigned(FXSQLVAR^.sqlind) then
1557	>	FXSQLVAR^.sqlind^ := 0;
1558	>	FModified := True;
1559	>	end;
1560	>	end;
1561	>
1562	>	procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1563	>	var
1564	>	i: Integer;
1565	>	begin
1566	>	if FUniqueName then
1567	>	xSetIsNull(Value)
1568	>	else
1569	>	for i := 0 to FParent.FCount - 1 do
1570	>	if FParent[i].FName = FName then
1571	>	FParent[i].xSetIsNull(Value);
1572	>	end;
1573	>
1574	>	procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1575	>	begin
1576	>	if (Value <> IsNullable) then
1577		begin
1578	<	for i := 0 to FParent.FCount - 1 do
1579	<	if FParent.FNames[i] = FName then
1580	<	begin
1581	<	xvar := FParent[i];
1582	<	xvar.FXSQLVAR^.sqlind^ := 0;
1583	<	xvar.FModified := True;
1584	<	end;
1578	>	if Value then
1579	>	begin
1580	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1581	>	IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1582	>	end
1583	>	else
1584	>	begin
1585	>	FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1586	>	ReallocMem(FXSQLVAR^.sqlind, 0);
1587	>	end;
1588		end;
1589		end;
1590
1591		procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1592		var
1593		i: Integer;
1315	–	xvar: TIBXSQLVAR;
1594		begin
1595	+	if FUniqueName then
1596	+	xSetIsNullable(Value)
1597	+	else
1598		for i := 0 to FParent.FCount - 1 do
1599	<	if FParent.FNames[i] = FName then
1600	<	begin
1601	<	xvar := FParent[i];
1602	<	if (Value <> IsNullable) then
1603	<	begin
1604	<	if Value then
1605	<	begin
1606	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1607	<	IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1608	<	end
1609	<	else
1610	<	begin
1611	<	xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1612	<	ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1613	<	end;
1614	<	end;
1599	>	if FParent[i].FName = FName then
1600	>	FParent[i].xSetIsNullable(Value);
1601	>	end;
1602	>
1603	>	procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1604	>	begin
1605	>	if IsNullable then
1606	>	IsNull := False;
1607	>
1608	>	FXSQLVAR^.sqltype := SQL_BOOLEAN;
1609	>	FXSQLVAR^.sqllen := 1;
1610	>	FXSQLVAR^.sqlscale := 0;
1611	>	IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1612	>	if AValue then
1613	>	PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1614	>	else
1615	>	PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1616	>	FModified := True;
1617	>	end;
1618	>
1619	>	procedure TIBXSQLVAR.Clear;
1620	>	begin
1621	>	IsNull := true;
1622	>	end;
1623	>
1624	>	function TIBXSQLVAR.GetCharSetID: integer;
1625	>	var stype: Integer;
1626	>	begin
1627	>	if FCharSetID = -1 then
1628	>	begin
1629	>	FCharSetID := 0;
1630	>	stype := FXSQLVAR^.sqltype and (not 1);
1631	>	case stype of
1632	>	SQL_TEXT,SQL_VARYING:
1633	>	FCharSetID := FXSQLVAR^.sqlsubtype and $FF;
1634	>
1635	>	SQL_BLOB:
1636	>	if (FXSQLVAR^.sqlsubtype = 1) and (strpas(FXSQLVAR^.relname) <> '') and
1637	>	(strpas(FXSQLVAR^.sqlname) <> '') then
1638	>	FCharSetID := GetBlobCharSetID(FParent.FSQL.Database.Handle,FParent.FSQL.Transaction.Handle,
1639	>	@(FXSQLVAR^.relname),@(FXSQLVAR^.sqlname));
1640		end;
1641	+
1642	+	if (FCharSetID > 1) and (FParent.FSQL.Database.DefaultCharSetName <> '')
1643	+	and (FParent.FSQL.Database.DefaultCharSetID > 1) then
1644	+	FCharSetID := FParent.FSQL.Database.DefaultCharSetID;
1645	+	end;
1646	+	Result := FCharSetID;
1647	+	end;
1648	+
1649	+	{$IFDEF HAS_ANSISTRING_CODEPAGE}
1650	+	function TIBXSQLVAR.GetCodePage: TSystemCodePage;
1651	+	begin
1652	+	TFirebirdCharacterSets.CharSetID2CodePage(GetCharSetID,Result);
1653		end;
1654	+	{$ENDIF}
1655	+
1656
1657		{ TIBXSQLDA }
1658	<	constructor TIBXSQLDA.Create(Query: TIBSQL);
1658	>	constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1659		begin
1660		inherited Create;
1661		FSQL := Query;
1342	–	FNames := TStringList.Create;
1662		FSize := 0;
1663		FUniqueRelationName := '';
1664	+	FInputSQLDA := sqldaType = daInput;
1665		end;
1666
1667		destructor TIBXSQLDA.Destroy;
1668		var
1669		i: Integer;
1670		begin
1351	–	FNames.Free;
1671		if FXSQLDA <> nil then
1672		begin
1673		for i := 0 to FSize - 1 do
#	Line 1361 \| Line 1680 \| begin
1680		FXSQLDA := nil;
1681		FXSQLVARs := nil;
1682		end;
1683	<	inherited;
1683	>	inherited Destroy;
1684		end;
1685
1686	<	procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1686	>	procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1687	>	UniqueName: boolean);
1688		var
1689	<	fn: String;
1689	>	fn: string;
1690		begin
1691	<	fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1692	<	while FNames.Count <= Idx do
1693	<	FNames.Add('');
1694	<	FNames[Idx] := fn;
1695	<	FXSQLVARs[Idx].FName := fn;
1691	>	{$ifdef UseCaseSensitiveParamName}
1692	>	FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1693	>	{$else}
1694	>	FXSQLVARs[Idx].FName := FieldName;
1695	>	{$endif}
1696		FXSQLVARs[Idx].FIndex := Idx;
1697	+	FXSQLVARs[Idx].FUniqueName := UniqueName
1698		end;
1699
1700		function TIBXSQLDA.GetModified: Boolean;
#	Line 1389 \| Line 1710 \| begin
1710		end;
1711		end;
1712
1392	–	function TIBXSQLDA.GetNames: String;
1393	–	begin
1394	–	result := FNames.Text;
1395	–	end;
1396	–
1713		function TIBXSQLDA.GetRecordSize: Integer;
1714		begin
1715		result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
#	Line 1421 \| Line 1737 \| end;
1737		function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1738		var
1739		s: String;
1740	<	i, Cnt: Integer;
1740	>	i: Integer;
1741		begin
1742	<	s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1743	<	i := 0;
1744	<	Cnt := FNames.Count;
1745	<	while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1746	<	if i = Cnt then
1747	<	result := nil
1748	<	else
1749	<	result := GetXSQLVAR(i);
1742	>	{$ifdef ALLOWDIALECT3PARAMNAMES}
1743	>	s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1744	>	{$else}
1745	>	{$ifdef UseCaseSensitiveParamName}
1746	>	s := AnsiUpperCase(Idx);
1747	>	{$else}
1748	>	s := Idx;
1749	>	{$endif}
1750	>	{$endif}
1751	>	for i := 0 to FCount - 1 do
1752	>	if Vars[i].FName = s then
1753	>	begin
1754	>	Result := FXSQLVARs[i];
1755	>	Exit;
1756	>	end;
1757	>	Result := nil;
1758		end;
1759
1760		procedure TIBXSQLDA.Initialize;
1761	+
1762	+	function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1763	+	var
1764	+	k: integer;
1765	+	begin
1766	+	for k := 0 to limit do
1767	+	if FXSQLVARs[k].FName = idx then
1768	+	begin
1769	+	Result := FXSQLVARs[k];
1770	+	Exit;
1771	+	end;
1772	+	Result := nil;
1773	+	end;
1774	+
1775		var
1776		i, j, j_len: Integer;
1439	–	NamesWereEmpty: Boolean;
1777		st: String;
1778		bUnique: Boolean;
1779	+	sBaseName: string;
1780		begin
1781		bUnique := True;
1782	<	NamesWereEmpty := (FNames.Count = 0);
1783	<	if FXSQLDA <> nil then begin
1784	<	for i := 0 to FCount - 1 do begin
1785	<	with FXSQLVARs[i].Data^ do begin
1786	<	if bUnique and (String(relname) <> '') then
1782	>	if FXSQLDA <> nil then
1783	>	begin
1784	>	for i := 0 to FCount - 1 do
1785	>	begin
1786	>	FXSQLVARs[i].FCharSetID := -1;
1787	>	with FXSQLVARs[i].Data^ do
1788	>	begin
1789	>
1790	>	{First get the unique relation name, if any}
1791	>
1792	>	if bUnique and (strpas(relname) <> '') then
1793		begin
1794		if FUniqueRelationName = '' then
1795	<	FUniqueRelationName := String(relname)
1796	<	else if String(relname) <> FUniqueRelationName then
1797	<	begin
1798	<	FUniqueRelationName := '';
1799	<	bUnique := False;
1800	<	end;
1795	>	FUniqueRelationName := strpas(relname)
1796	>	else
1797	>	if strpas(relname) <> FUniqueRelationName then
1798	>	begin
1799	>	FUniqueRelationName := '';
1800	>	bUnique := False;
1801	>	end;
1802		end;
1803	<	if NamesWereEmpty then begin
1804	<	st := String(aliasname);
1805	<	if st = '' then begin
1806	<	st := 'F_'; {do not localize}
1803	>
1804	>	{If an output SQLDA then copy the aliasnames to the FName list. Ensure
1805	>	that they are all upper case only and disambiguated.
1806	>	}
1807	>
1808	>	if not FInputSQLDA then
1809	>	begin
1810	>	st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1811	>	if st = '' then
1812	>	begin
1813	>	sBaseName := 'F_'; {do not localize}
1814		aliasname_length := 2;
1815		j := 1; j_len := 1;
1816	<	StrPCopy(aliasname, st + IntToStr(j));
1817	<	end else begin
1818	<	StrPCopy(aliasname, st);
1816	>	st := sBaseName + IntToStr(j);
1817	>	end
1818	>	else
1819	>	begin
1820		j := 0; j_len := 0;
1821	+	sBaseName := st;
1822		end;
1823	<	while GetXSQLVARByName(String(aliasname)) <> nil do begin
1824	<	Inc(j); j_len := Length(IntToStr(j));
1825	<	if j_len + aliasname_length > 31 then
1826	<	StrPCopy(aliasname,
1827	<	Copy(st, 1, 31 - j_len) +
1828	<	IntToStr(j))
1829	<	else
1830	<	StrPCopy(aliasname, st + IntToStr(j));
1823	>
1824	>	{Look for other columns with the same name and make unique}
1825	>
1826	>	while VarByName(st,i-1) <> nil do
1827	>	begin
1828	>	Inc(j);
1829	>	j_len := Length(IntToStr(j));
1830	>	if j_len + Length(sBaseName) > 31 then
1831	>	st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1832	>	else
1833	>	st := sBaseName + IntToStr(j);
1834		end;
1835	<	Inc(aliasname_length, j_len);
1836	<	AddName(String(aliasname), i);
1835	>
1836	>	FXSQLVARs[i].FName := st;
1837		end;
1838	+
1839	+	{Finally initialise the XSQLVAR}
1840	+
1841	+	FXSQLVARs[i].FIndex := i;
1842	+
1843		case sqltype and (not 1) of
1844		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1845	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1845	>	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1846		SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1847		if (sqllen = 0) then
1848		{ Make sure you get a valid pointer anyway
#	Line 1510 \| Line 1872 \| var
1872		i, OldSize: Integer;
1873		p : PXSQLVAR;
1874		begin
1513	–	FNames.Clear;
1875		FCount := Value;
1876		if FCount = 0 then
1877		FUniqueRelationName := ''
#	Line 1532 \| Line 1893 \| begin
1893		FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1894		FXSQLVARs[i].FXSQLVAR := p;
1895		p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1535	–	// FNames.Add('');
1896		end;
1897		FSize := FCount;
1898		end;
#	Line 1548 \| Line 1908 \| end;
1908
1909		destructor TIBOutputDelimitedFile.Destroy;
1910		begin
1911	+	{$IFDEF UNIX}
1912	+	if FHandle <> -1 then
1913	+	fpclose(FHandle);
1914	+	{$ELSE}
1915		if FHandle <> 0 then
1916		begin
1917		FlushFileBuffers(FHandle);
1918		CloseHandle(FHandle);
1919		end;
1920	+	{$ENDIF}
1921		inherited Destroy;
1922		end;
1923
1924		procedure TIBOutputDelimitedFile.ReadyFile;
1925		var
1926		i: Integer;
1927	+	{$IFDEF UNIX}
1928	+	BytesWritten: cint;
1929	+	{$ELSE}
1930		BytesWritten: DWORD;
1931	+	{$ENDIF}
1932		st: string;
1933		begin
1934		if FColDelimiter = '' then
1935		FColDelimiter := TAB;
1936		if FRowDelimiter = '' then
1937		FRowDelimiter := CRLF;
1938	+	{$IFDEF UNIX}
1939	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1940	+	{$ELSE}
1941		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1942		FILE_ATTRIBUTE_NORMAL, 0);
1943		if FHandle = INVALID_HANDLE_VALUE then
1944		FHandle := 0;
1945	+	{$ENDIF}
1946		if FOutputTitles then
1947		begin
1948		for i := 0 to Columns.Count - 1 do
1949		if i = 0 then
1950	<	st := string(Columns[i].Data^.aliasname)
1950	>	st := strpas(Columns[i].Data^.aliasname)
1951		else
1952	<	st := st + FColDelimiter + string(Columns[i].Data^.aliasname);
1952	>	st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1953		st := st + FRowDelimiter;
1954	+	{$IFDEF UNIX}
1955	+	if FHandle <> -1 then
1956	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1957	+	if BytesWritten = -1 then
1958	+	raise Exception.Create('File Write Error');
1959	+	{$ELSE}
1960		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1961	+	{$ENDIF}
1962		end;
1963		end;
1964
1965		function TIBOutputDelimitedFile.WriteColumns: Boolean;
1966		var
1967		i: Integer;
1968	+	{$IFDEF UNIX}
1969	+	BytesWritten: cint;
1970	+	{$ELSE}
1971		BytesWritten: DWORD;
1972	+	{$ENDIF}
1973		st: string;
1974		begin
1975		result := False;
1976	+	{$IFDEF UNIX}
1977	+	if FHandle <> -1 then
1978	+	{$ELSE}
1979		if FHandle <> 0 then
1980	+	{$ENDIF}
1981		begin
1982		st := '';
1983		for i := 0 to Columns.Count - 1 do
#	Line 1599 \| Line 1987 \| begin
1987		st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1988		end;
1989		st := st + FRowDelimiter;
1990	+	{$IFDEF UNIX}
1991	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1992	+	{$ELSE}
1993		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1994	+	{$ENDIF}
1995		if BytesWritten = DWORD(Length(st)) then
1996		result := True;
1997		end
#	Line 1712 \| Line 2104 \| end;
2104		{ TIBOutputRawFile }
2105		destructor TIBOutputRawFile.Destroy;
2106		begin
2107	+	{$IFDEF UNIX}
2108	+	if FHandle <> -1 then
2109	+	fpclose(FHandle);
2110	+	{$ELSE}
2111		if FHandle <> 0 then
2112		begin
2113		FlushFileBuffers(FHandle);
2114		CloseHandle(FHandle);
2115		end;
2116	+	{$ENDIF}
2117		inherited Destroy;
2118		end;
2119
2120		procedure TIBOutputRawFile.ReadyFile;
2121		begin
2122	+	{$IFDEF UNIX}
2123	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
2124	+	{$ELSE}
2125		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
2126		FILE_ATTRIBUTE_NORMAL, 0);
2127		if FHandle = INVALID_HANDLE_VALUE then
2128		FHandle := 0;
2129	+	{$ENDIF}
2130		end;
2131
2132		function TIBOutputRawFile.WriteColumns: Boolean;
#	Line 1738 \| Line 2139 \| begin
2139		begin
2140		for i := 0 to Columns.Count - 1 do
2141		begin
2142	+	{$IFDEF UNIX}
2143	+	BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
2144	+	{$ELSE}
2145		WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
2146		BytesWritten, nil);
2147	+	{$ENDIF}
2148		if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
2149		exit;
2150		end;
#	Line 1750 \| Line 2155 \| end;
2155		{ TIBInputRawFile }
2156		destructor TIBInputRawFile.Destroy;
2157		begin
2158	+	{$IFDEF UNIX}
2159	+	if FHandle <> -1 then
2160	+	fpclose(FHandle);
2161	+	{$ELSE}
2162		if FHandle <> 0 then
2163		CloseHandle(FHandle);
2164	<	inherited;
2164	>	{$ENDIF}
2165	>	inherited Destroy;
2166		end;
2167
2168		function TIBInputRawFile.ReadParameters: Boolean;
#	Line 1761 \| Line 2171 \| var
2171		BytesRead: DWord;
2172		begin
2173		result := False;
2174	+	{$IFDEF UNIX}
2175	+	if FHandle <> -1 then
2176	+	{$ELSE}
2177		if FHandle <> 0 then
2178	+	{$ENDIF}
2179		begin
2180		for i := 0 to Params.Count - 1 do
2181		begin
2182	+	{$IFDEF UNIX}
2183	+	BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
2184	+	{$ELSE}
2185		ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
2186		BytesRead, nil);
2187	+	{$ENDIF}
2188		if BytesRead <> DWORD(Params[i].Data^.sqllen) then
2189		exit;
2190		end;
#	Line 1776 \| Line 2194 \| end;
2194
2195		procedure TIBInputRawFile.ReadyFile;
2196		begin
2197	+	{$IFDEF UNIX}
2198	+	if FHandle <> -1 then
2199	+	fpclose(FHandle);
2200	+	FHandle := FpOpen(Filename,O_RdOnly);
2201	+	if FHandle = -1 then
2202	+	raise Exception.CreateFmt('Unable to open file %s',[Filename]);
2203	+	{$ELSE}
2204		if FHandle <> 0 then
2205		CloseHandle(FHandle);
2206		FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
2207		FILE_FLAG_SEQUENTIAL_SCAN, 0);
2208		if FHandle = INVALID_HANDLE_VALUE then
2209		FHandle := 0;
2210	+	{$ENDIF}
2211		end;
2212
2213		{ TIBSQL }
2214		constructor TIBSQL.Create(AOwner: TComponent);
2215	+	var GUID : TGUID;
2216		begin
2217		inherited Create(AOwner);
2218		FIBLoaded := False;
#	Line 1802 \| Line 2229 \| begin
2229		FRecordCount := 0;
2230		FSQL := TStringList.Create;
2231		TStringList(FSQL).OnChanging := SQLChanging;
2232	+	TStringList(FSQL).OnChange := SQLChanged;
2233		FProcessedSQL := TStringList.Create;
2234		FHandle := nil;
2235	<	FSQLParams := TIBXSQLDA.Create(self);
2236	<	FSQLRecord := TIBXSQLDA.Create(self);
2235	>	FSQLParams := TIBXSQLDA.Create(self,daInput);
2236	>	FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2237		FSQLType := SQLUnknown;
2238		FParamCheck := True;
2239	<	FCursor := Name + RandomString(8);
2239	>	CreateGuid(GUID);
2240	>	FCursor := GUIDToString(GUID);
2241		if AOwner is TIBDatabase then
2242		Database := TIBDatabase(AOwner)
2243		else
#	Line 1830 \| Line 2259 \| begin
2259		FSQLParams.Free;
2260		FSQLRecord.Free;
2261		end;
2262	<	inherited;
2262	>	inherited Destroy;
2263		end;
2264
2265		procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
#	Line 1918 \| Line 2347 \| begin
2347		result := FSQLRecord;
2348		end;
2349
2350	+	function TIBSQL.GetFieldCount: integer;
2351	+	begin
2352	+	Result := FSQLRecord.Count
2353	+	end;
2354	+
2355	+	procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2356	+	begin
2357	+	if FUniqueParamNames = AValue then Exit;
2358	+	FreeHandle;
2359	+	FUniqueParamNames := AValue;
2360	+	end;
2361	+
2362		procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2363		begin
2364		if (FHandle <> nil) then begin
#	Line 1948 \| Line 2389 \| begin
2389		FBOF := True;
2390		FEOF := False;
2391		FRecordCount := 0;
2392	+	if not (csDesigning in ComponentState) then
2393	+	MonitorHook.SQLExecute(Self);
2394		if FGoToFirstRecordOnExecute then
2395		Next;
2396		end;
#	Line 1957 \| Line 2400 \| begin
2400		@FHandle,
2401		Database.SQLDialect,
2402		FSQLParams.AsXSQLDA,
2403	<	FSQLRecord.AsXSQLDA), False);
2404	<	if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2403	>	FSQLRecord.AsXSQLDA), True);
2404	>	if not (csDesigning in ComponentState) then
2405	>	MonitorHook.SQLExecute(Self);
2406	>	(* if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2407		begin
2408		{ Sometimes a prepared stored procedure appears to get
2409		off sync on the server ....This code is meant to try
#	Line 1973 \| Line 2418 \| begin
2418		Database.SQLDialect,
2419		FSQLParams.AsXSQLDA,
2420		FSQLRecord.AsXSQLDA), True);
2421	<	end;
2421	>	end; *)
2422		end
2423		else
2424		Call(isc_dsql_execute(StatusVector,
2425		TRHandle,
2426		@FHandle,
2427		Database.SQLDialect,
2428	<	FSQLParams.AsXSQLDA), True)
2428	>	FSQLParams.AsXSQLDA), True);
2429	>	if not (csDesigning in ComponentState) then
2430	>	MonitorHook.SQLExecute(Self);
2431		end;
2432	<	if not (csDesigning in ComponentState) then
2433	<	MonitorHook.SQLExecute(Self);
2432	>	FBase.DoAfterExecQuery(self);
2433	>	// writeln('Rows Affected = ',RowsAffected);
2434		end;
2435
2436		function TIBSQL.GetEOF: Boolean;
#	Line 2001 \| Line 2448 \| begin
2448		result := GetFields(i);
2449		end;
2450
2451	+	function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2452	+	begin
2453	+	Result := Params.ByName(ParamName);
2454	+	end;
2455	+
2456		function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2457		begin
2458		if (Idx < 0) or (Idx >= FSQLRecord.Count) then
#	Line 2090 \| Line 2542 \| begin
2542		SQLUpdate, SQLDelete])) then
2543		result := ''
2544		else begin
2545	<	info_request := Char(isc_info_sql_get_plan);
2545	>	info_request := isc_info_sql_get_plan;
2546		Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2547		SizeOf(result_buffer), result_buffer), True);
2548	<	if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2548	>	if (result_buffer[0] <> isc_info_sql_get_plan) then
2549		IBError(ibxeUnknownError, [nil]);
2550		result_length := isc_vax_integer(@result_buffer[1], 2);
2551		SetString(result, nil, result_length);
#	Line 2108 \| Line 2560 \| begin
2560		result := FRecordCount;
2561		end;
2562
2563	<	function TIBSQL.GetRowsAffected: integer;
2563	>	function TIBSQL.GetRowsAffected: Integer;
2564		var
2113	–	result_buffer: array[0..1048] of Char;
2565		info_request: Char;
2566	+	RB: TResultBuffer;
2567		begin
2568		if not Prepared then
2569		result := -1
2570		else begin
2571	<	info_request := Char(isc_info_sql_records);
2572	<	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2573	<	SizeOf(result_buffer), result_buffer) > 0 then
2574	<	IBDatabaseError;
2575	<	if (result_buffer[0] <> Char(isc_info_sql_records)) then
2576	<	result := -1
2577	<	else
2578	<	case SQLType of
2579	<	SQLUpdate: Result := isc_vax_integer(@result_buffer[6], 4);
2580	<	SQLDelete: Result := isc_vax_integer(@result_buffer[13], 4);
2581	<	SQLInsert: Result := isc_vax_integer(@result_buffer[27], 4);
2582	<	else Result := -1 ;
2583	<	end ;
2571	>	RB := TResultBuffer.Create;
2572	>	try
2573	>	info_request := isc_info_sql_records;
2574	>	if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2575	>	RB.Size, RB.buffer) > 0 then
2576	>	IBDatabaseError;
2577	>	case SQLType of
2578	>	SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2579	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2580	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2581	>	SQLDelete:
2582	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2583	>	SQLExecProcedure:
2584	>	Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2585	>	RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2586	>	RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2587	>	else
2588	>	Result := 0;
2589	>	end;
2590	>	finally
2591	>	RB.Free;
2592	>	end;
2593		end;
2594		end;
2595
#	Line 2159 \| Line 2620 \| var
2620		cCurChar, cNextChar, cQuoteChar: Char;
2621		sSQL, sProcessedSQL, sParamName: String;
2622		i, iLenSQL, iSQLPos: Integer;
2623	<	iCurState, iCurParamState: Integer;
2623	>	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2624		iParamSuffix: Integer;
2625		slNames: TStrings;
2626
#	Line 2168 \| Line 2629 \| const
2629		CommentState = 1;
2630		QuoteState = 2;
2631		ParamState = 3;
2632	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2633		ParamDefaultState = 0;
2634		ParamQuoteState = 1;
2635	+	{$endif}
2636
2637		procedure AddToProcessedSQL(cChar: Char);
2638		begin
#	Line 2178 \| Line 2641 \| const
2641		end;
2642
2643		begin
2644	+	sParamName := '';
2645		slNames := TStringList.Create;
2646		try
2647		{ Do some initializations of variables }
#	Line 2189 \| Line 2653 \| begin
2653		i := 1;
2654		iSQLPos := 1;
2655		iCurState := DefaultState;
2656	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2657		iCurParamState := ParamDefaultState;
2658	+	{$endif}
2659		{ Now, traverse through the SQL string, character by character,
2660		picking out the parameters and formatting correctly for InterBase }
2661		while (i <= iLenSQL) do begin
#	Line 2240 \| Line 2706 \| begin
2706		ParamState:
2707		begin
2708		{ collect the name of the parameter }
2709	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2710		if iCurParamState = ParamDefaultState then
2711		begin
2712		if cCurChar = '"' then
2713		iCurParamState := ParamQuoteState
2714	<	else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2714	>	else
2715	>	{$endif}
2716	>	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2717		sParamName := sParamName + cCurChar
2718		else if FGenerateParamNames then
2719		begin
2720		sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2721		Inc(iParamSuffix);
2722		iCurState := DefaultState;
2723	<	slNames.Add(sParamName);
2723	>	slNames.AddObject(sParamName,self); //Note local convention
2724	>	//add pointer to self to mark entry
2725		sParamName := '';
2726		end
2727		else
2728		IBError(ibxeSQLParseError, [SParamNameExpected]);
2729	+	{$ifdef ALLOWDIALECT3PARAMNAMES}
2730		end
2731		else begin
2732		{ determine if Quoted parameter name is finished }
#	Line 2270 \| Line 2741 \| begin
2741		else
2742		sParamName := sParamName + cCurChar
2743		end;
2744	+	{$endif}
2745		{ determine if the unquoted parameter name is finished }
2746	<	if (iCurParamState <> ParamQuoteState) and
2746	>	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2747		(iCurState <> DefaultState) then
2748		begin
2749		if not (cNextChar in ['A'..'Z', 'a'..'z',
#	Line 2291 \| Line 2763 \| begin
2763		AddToProcessedSQL(#0);
2764		FSQLParams.Count := slNames.Count;
2765		for i := 0 to slNames.Count - 1 do
2766	<	FSQLParams.AddName(slNames[i], i);
2766	>	FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2767		FProcessedSQL.Text := sProcessedSQL;
2768		finally
2769		slNames.Free;
#	Line 2330 \| Line 2802 \| begin
2802		{ After preparing the statement, query the stmt type and possibly
2803		create a FSQLRecord "holder" }
2804		{ Get the type of the statement }
2805	<	type_item := Char(isc_info_sql_stmt_type);
2805	>	type_item := isc_info_sql_stmt_type;
2806		Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2807		SizeOf(res_buffer), res_buffer), True);
2808	<	if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2808	>	if (res_buffer[0] <> isc_info_sql_stmt_type) then
2809		IBError(ibxeUnknownError, [nil]);
2810		stmt_len := isc_vax_integer(@res_buffer[1], 2);
2811		FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
#	Line 2378 \| Line 2850 \| begin
2850		on E: Exception do begin
2851		if (FHandle <> nil) then
2852		FreeHandle;
2853	<	raise;
2853	>	if E is EIBInterBaseError then
2854	>	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2855	>	EIBInterBaseError(E).IBErrorCode,
2856	>	EIBInterBaseError(E).Message +
2857	>	sSQLErrorSeparator + FProcessedSQL.Text)
2858	>	else
2859	>	raise;
2860		end;
2861		end;
2862		end;
#	Line 2416 \| Line 2894 \| begin
2894		if FHandle <> nil then FreeHandle;
2895		end;
2896
2897	<	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2897	>	procedure TIBSQL.SQLChanged(Sender: TObject);
2898	>	begin
2899	>	if assigned(OnSQLChanged) then
2900	>	OnSQLChanged(self);
2901	>	end;
2902	>
2903	>	procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
2904	>	Action: TTransactionAction);
2905		begin
2906		if (FOpen) then
2907		Close;

Diff Legend

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

Comparing ibx/trunk/runtime/IBSQL.pas (file contents): Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs. Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

Diff Legend

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC