ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBSQL.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
27 + {    IBX For Lazarus (Firebird Express)                                  }
28 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 + {    Portions created by MWA Software are copyright McCallum Whyman      }
30 + {    Associates Ltd 2011 - 2014                                                }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBSQL;
35  
36   {$Mode Delphi}
37  
38 + { IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
39 +
40 + Dialect 3 quoted format parameter names represent a significant overhead and are of
41 + limited value - especially for users that use only TIBSQL or TIBCustomDataset
42 + descendents. They were previously used internally by IBX to simplify SQL generation
43 + for TTable components in Master/Slave relationships which are linked by
44 + Dialect 3 names. They were also generated by TStoredProc when the original
45 + parameter names are quoted.
46 +
47 + However, for some users they do cause a big processing overhead. The TTable/TStoredProc
48 + code has been re-written so that they are no required by IBX internally.
49 + The code to support quoted parameter names is now subject  to conditional compilation.
50 + To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled.
51 +
52 + Hint: deleting the space between the brace and the dollar sign below
53 +
54 + }
55 +
56 + { $define ALLOWDIALECT3PARAMNAMES}
57 +
58 + {$ifndef ALLOWDIALECT3PARAMNAMES}
59 +
60 + { Even when dialect 3 quoted format parameter names are not supported, IBX still processes
61 +  parameter names case insensitive. This does result in some additional overhead
62 +  due to a call to "AnsiUpperCase". This can be avoided by undefining
63 +  "UseCaseSensitiveParamName" below.
64 +
65 +  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
66 +  is defined. This will not give a useful result.
67 + }
68 + {$define UseCaseSensitiveParamName}
69 + {$endif}
70 +
71   interface
72  
73   uses
74 < {$IFDEF LINUX }
37 <  baseunix,unix,
38 < {$ELSE}
39 < {$DEFINE HAS_SQLMONITOR}
74 > {$IFDEF WINDOWS }
75    Windows,
76 + {$ELSE}
77 +  baseunix, unix,
78   {$ENDIF}
79    SysUtils, Classes, Forms, Controls, IBHeader,
80    IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
# Line 54 | Line 91 | type
91      FIndex: Integer;
92      FModified: Boolean;
93      FName: String;
94 +    FUniqueName: boolean;
95      FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
96  
97      function AdjustScale(Value: Int64; Scale: Integer): Double;
# Line 91 | Line 129 | type
129      procedure SetAsXSQLVAR(Value: PXSQLVAR);
130      procedure SetIsNull(Value: Boolean);
131      procedure SetIsNullable(Value: Boolean);
132 +    procedure xSetAsCurrency(Value: Currency);
133 +    procedure xSetAsInt64(Value: Int64);
134 +    procedure xSetAsDate(Value: TDateTime);
135 +    procedure xSetAsTime(Value: TDateTime);
136 +    procedure xSetAsDateTime(Value: TDateTime);
137 +    procedure xSetAsDouble(Value: Double);
138 +    procedure xSetAsFloat(Value: Float);
139 +    procedure xSetAsLong(Value: Long);
140 +    procedure xSetAsPointer(Value: Pointer);
141 +    procedure xSetAsQuad(Value: TISC_QUAD);
142 +    procedure xSetAsShort(Value: Short);
143 +    procedure xSetAsString(Value: String);
144 +    procedure xSetAsVariant(Value: Variant);
145 +    procedure xSetAsXSQLVAR(Value: PXSQLVAR);
146 +    procedure xSetIsNull(Value: Boolean);
147 +    procedure xSetIsNullable(Value: Boolean);
148    public
149      constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
150      procedure Assign(Source: TIBXSQLVAR);
151 +    procedure Clear;
152      procedure LoadFromFile(const FileName: String);
153      procedure LoadFromStream(Stream: TStream);
154      procedure SaveToFile(const FileName: String);
# Line 126 | Line 181 | type
181  
182    TIBXSQLVARArray = Array of TIBXSQLVAR;
183  
184 <  { TIBXSQLVAR }
184 >  TIBXSQLDAType = (daInput,daOutput);
185 >
186 >  { TIBXSQLDA }
187 >
188    TIBXSQLDA = class(TObject)
189    protected
190      FSQL: TIBSQL;
191      FCount: Integer;
134 –    FNames: TStrings;
192      FSize: Integer;
193 +    FInputSQLDA: boolean;
194      FXSQLDA: PXSQLDA;
195      FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
196      FUniqueRelationName: String;
197      function GetModified: Boolean;
140 –    function GetNames: String;
198      function GetRecordSize: Integer;
199      function GetXSQLDA: PXSQLDA;
200      function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
# Line 145 | Line 202 | type
202      procedure Initialize;
203      procedure SetCount(Value: Integer);
204    public
205 <    constructor Create(Query: TIBSQL);
205 >    constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
206      destructor Destroy; override;
207 <    procedure AddName(FieldName: String; Idx: Integer);
207 >     procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
208      function ByName(Idx: String): TIBXSQLVAR;
209      property AsXSQLDA: PXSQLDA read GetXSQLDA;
210      property Count: Integer read FCount write SetCount;
211      property Modified: Boolean read GetModified;
155 –    property Names: String read GetNames;
212      property RecordSize: Integer read GetRecordSize;
213      property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
214      property UniqueRelationName: String read FUniqueRelationName;
# Line 186 | Line 242 | type
242    { TIBOutputDelimitedFile }
243    TIBOutputDelimitedFile = class(TIBBatchOutput)
244    protected
245 <  {$IFDEF LINUX}
245 >  {$IFDEF UNIX}
246      FHandle: cint;
247    {$ELSE}
248      FHandle: THandle;
# Line 229 | Line 285 | type
285    { TIBOutputRawFile }
286    TIBOutputRawFile = class(TIBBatchOutput)
287    protected
288 <  {$IFDEF LINUX}
288 >  {$IFDEF UNIX}
289      FHandle: cint;
290    {$ELSE}
291      FHandle: THandle;
# Line 243 | Line 299 | type
299    { TIBInputRawFile }
300    TIBInputRawFile = class(TIBBatchInput)
301    protected
302 <   {$IFDEF LINUX}
302 >   {$IFDEF UNIX}
303      FHandle: cint;
304    {$ELSE}
305      FHandle: THandle;
# Line 265 | Line 321 | type
321    TIBSQL = class(TComponent)
322    private
323      FIBLoaded: Boolean;
324 +    FUniqueParamNames: Boolean;
325 +    function GetFieldCount: integer;
326 +    procedure SetUniqueParamNames(AValue: Boolean);
327    protected
328      FBase: TIBBase;
329      FBOF,                          { At BOF? }
# Line 324 | Line 383 | type
383      property Eof: Boolean read GetEOF;
384      property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
385      property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
386 +    property FieldCount: integer read GetFieldCount;
387      property Open: Boolean read FOpen;
388      property Params: TIBXSQLDA read GetSQLParams;
389      property Plan: String read GetPlan;
# Line 333 | Line 393 | type
393      property SQLType: TIBSQLTypes read FSQLType;
394      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
395      property Handle: TISC_STMT_HANDLE read FHandle;
336 –    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
396      property UniqueRelationName: String read GetUniqueRelationName;
397    published
398      property Database: TIBDatabase read GetDatabase write SetDatabase;
399 +    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
400 +    property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
401      property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
402                                                 write FGoToFirstRecordOnExecute
403                                                 default True;
# Line 349 | Line 410 | type
410   implementation
411  
412   uses
413 <  IBIntf, IBBlob, Variants {$IFDEF HAS_SQLMONITOR}, IBSQLMonitor {$ENDIF};
413 >  IBIntf, IBBlob, Variants , IBSQLMonitor;
414  
415   { TIBXSQLVAR }
416   constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
# Line 364 | Line 425 | var
425    szBuff: PChar;
426    s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
427    bSourceBlob, bDestBlob: Boolean;
428 <  iSegs, iMaxSeg, iSize: Long;
428 >  iSegs: Int64;
429 >  iMaxSeg: Int64;
430 >  iSize: Int64;
431    iBlobType: Short;
432   begin
433    szBuff := nil;
# Line 426 | Line 489 | begin
489          0, nil), True);
490        try
491          IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
492 +        isNull := false
493        finally
494          FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
495        end;
# Line 584 | Line 648 | end;
648   function TIBXSQLVAR.GetAsDateTime: TDateTime;
649   var
650    tm_date: TCTimeStructure;
651 +  msecs: word;
652   begin
653    result := 0;
654    if not IsNull then
# Line 609 | Line 674 | begin
674        SQL_TYPE_TIME: begin
675          isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
676          try
677 +          msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
678            result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
679 <                               Word(tm_date.tm_sec), 0)
679 >                               Word(tm_date.tm_sec), msecs)
680          except
681            on E: EConvertError do begin
682              IBError(ibxeInvalidDataConversion, [nil]);
# Line 622 | Line 688 | begin
688          try
689            result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
690                                Word(tm_date.tm_mday));
691 +          msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
692            if result >= 0 then
693              result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
694 <                                          Word(tm_date.tm_sec), 0)
694 >                                          Word(tm_date.tm_sec), msecs)
695            else
696              result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
697 <                                          Word(tm_date.tm_sec), 0)
697 >                                          Word(tm_date.tm_sec), msecs)
698          except
699            on E: EConvertError do begin
700              IBError(ibxeInvalidDataConversion, [nil]);
# Line 757 | Line 824 | begin
824          result := '(Array)'; {do not localize}
825        SQL_BLOB: begin
826          ss := TStringStream.Create('');
827 <        SaveToStream(ss);
828 <        result := ss.DataString;
829 <        ss.Free;
827 >        try
828 >          SaveToStream(ss);
829 >          result := ss.DataString;
830 >        finally
831 >          ss.Free;
832 >        end;
833        end;
834        SQL_TEXT, SQL_VARYING: begin
835          sz := FXSQLVAR^.sqldata;
# Line 921 | Line 991 | begin
991    result := FXSQLVAR^.sqltype and (not 1);
992   end;
993  
994 + procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
995 + begin
996 +  if IsNullable then
997 +    IsNull := False;
998 +  FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
999 +  FXSQLVAR^.sqlscale := -4;
1000 +  FXSQLVAR^.sqllen := SizeOf(Int64);
1001 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1002 +  PCurrency(FXSQLVAR^.sqldata)^ := Value;
1003 +  FModified := True;
1004 + end;
1005 +
1006   procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1007   var
926 –  xvar: TIBXSQLVAR;
1008    i: Integer;
1009   begin
1010    if FSQL.Database.SQLDialect < 3 then
1011      AsDouble := Value
1012    else
1013    begin
1014 <    if IsNullable then
1015 <      IsNull := False;
1014 >
1015 >    if FUniqueName then
1016 >       xSetAsCurrency(Value)
1017 >    else
1018      for i := 0 to FParent.FCount - 1 do
1019 <      if FParent.FNames[i] = FName then
1020 <      begin
938 <        xvar := FParent[i];
939 <        xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
940 <        xvar.FXSQLVAR^.sqlscale := -4;
941 <        xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
942 <        IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
943 <        PCurrency(xvar.FXSQLVAR^.sqldata)^ := Value;
944 <        xvar.FModified := True;
945 <      end;
1019 >      if FParent[i].FName = FName then
1020 >           FParent[i].xSetAsCurrency(Value);
1021    end;
1022   end;
1023  
1024 + procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1025 + begin
1026 +  if IsNullable then
1027 +    IsNull := False;
1028 +
1029 +  FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1030 +  FXSQLVAR^.sqlscale := 0;
1031 +  FXSQLVAR^.sqllen := SizeOf(Int64);
1032 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1033 +  PInt64(FXSQLVAR^.sqldata)^ := Value;
1034 +  FModified := True;
1035 + end;
1036 +
1037   procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1038   var
1039    i: Integer;
1040 <  xvar: TIBXSQLVAR;
1040 > begin
1041 >  if FUniqueName then
1042 >     xSetAsInt64(Value)
1043 >  else
1044 >  for i := 0 to FParent.FCount - 1 do
1045 >    if FParent[i].FName = FName then
1046 >          FParent[i].xSetAsInt64(Value);
1047 > end;
1048 >
1049 > procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1050 > var
1051 >   tm_date: TCTimeStructure;
1052 >   Yr, Mn, Dy: Word;
1053   begin
1054    if IsNullable then
1055      IsNull := False;
1056 <  for i := 0 to FParent.FCount - 1 do
1057 <    if FParent.FNames[i] = FName then
1058 <    begin
1059 <      xvar := FParent[i];
1060 <      xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1061 <      xvar.FXSQLVAR^.sqlscale := 0;
1062 <      xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1063 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1064 <      PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1065 <      xvar.FModified := True;
1066 <    end;
1056 >
1057 >  FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1058 >  DecodeDate(Value, Yr, Mn, Dy);
1059 >  with tm_date do begin
1060 >    tm_sec := 0;
1061 >    tm_min := 0;
1062 >    tm_hour := 0;
1063 >    tm_mday := Dy;
1064 >    tm_mon := Mn - 1;
1065 >    tm_year := Yr - 1900;
1066 >  end;
1067 >  FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1068 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1069 >  isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1070 >  FModified := True;
1071   end;
1072  
1073   procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1074   var
1075    i: Integer;
972 –  tm_date: TCTimeStructure;
973 –  Yr, Mn, Dy: Word;
974 –  xvar: TIBXSQLVAR;
1076   begin
1077    if FSQL.Database.SQLDialect < 3 then
1078    begin
1079      AsDateTime := Value;
1080      exit;
1081    end;
1082 +
1083 +  if FUniqueName then
1084 +     xSetAsDate(Value)
1085 +  else
1086 +  for i := 0 to FParent.FCount - 1 do
1087 +    if FParent[i].FName = FName then
1088 +       FParent[i].xSetAsDate(Value);
1089 + end;
1090 +
1091 + procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1092 + var
1093 +  tm_date: TCTimeStructure;
1094 +  Hr, Mt, S, Ms: Word;
1095 + begin
1096    if IsNullable then
1097      IsNull := False;
1098 <  for i := 0 to FParent.FCount - 1 do
1099 <    if FParent.FNames[i] = FName then
1100 <    begin
1101 <      xvar := FParent[i];
1102 <      xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1103 <      DecodeDate(Value, Yr, Mn, Dy);
1104 <      with tm_date do begin
1105 <        tm_sec := 0;
1106 <        tm_min := 0;
1107 <        tm_hour := 0;
1108 <        tm_mday := Dy;
1109 <        tm_mon := Mn - 1;
1110 <        tm_year := Yr - 1900;
1111 <      end;
1112 <      xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1113 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1114 <      isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
1000 <      xvar.FModified := True;
1001 <    end;
1098 >
1099 >  FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1100 >  DecodeTime(Value, Hr, Mt, S, Ms);
1101 >  with tm_date do begin
1102 >    tm_sec := S;
1103 >    tm_min := Mt;
1104 >    tm_hour := Hr;
1105 >    tm_mday := 0;
1106 >    tm_mon := 0;
1107 >    tm_year := 0;
1108 >  end;
1109 >  FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1110 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1111 >  isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1112 >  if Ms > 0 then
1113 >    Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1114 >  FModified := True;
1115   end;
1116  
1117   procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1118   var
1119    i: Integer;
1007 –  tm_date: TCTimeStructure;
1008 –  Hr, Mt, S, Ms: Word;
1009 –  xvar: TIBXSQLVAR;
1120   begin
1121    if FSQL.Database.SQLDialect < 3 then
1122    begin
1123      AsDateTime := Value;
1124      exit;
1125    end;
1126 <  if IsNullable then
1127 <    IsNull := False;
1126 >
1127 >  if FUniqueName then
1128 >     xSetAsTime(Value)
1129 >  else
1130    for i := 0 to FParent.FCount - 1 do
1131 <    if FParent.FNames[i] = FName then
1132 <    begin
1021 <      xvar := FParent[i];
1022 <      xvar.FXSQLVAR^.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR^.sqltype and 1);
1023 <      DecodeTime(Value, Hr, Mt, S, Ms);
1024 <      with tm_date do begin
1025 <        tm_sec := S;
1026 <        tm_min := Mt;
1027 <        tm_hour := Hr;
1028 <        tm_mday := 0;
1029 <        tm_mon := 0;
1030 <        tm_year := 0;
1031 <      end;
1032 <      xvar.FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1033 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1034 <      isc_encode_sql_time(@tm_date, PISC_TIME(xvar.FXSQLVAR^.sqldata));
1035 <      xvar.FModified := True;
1036 <    end;
1131 >    if FParent[i].FName = FName then
1132 >       FParent[i].xSetAsTime(Value);
1133   end;
1134  
1135 < procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1135 > procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1136   var
1041 –  i: Integer;
1137    tm_date: TCTimeStructure;
1138    Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1044 –  xvar: TIBXSQLVAR;
1139   begin
1140    if IsNullable then
1141      IsNull := False;
1142 +
1143 +  FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1144 +  DecodeDate(Value, Yr, Mn, Dy);
1145 +  DecodeTime(Value, Hr, Mt, S, Ms);
1146 +  with tm_date do begin
1147 +    tm_sec := S;
1148 +    tm_min := Mt;
1149 +    tm_hour := Hr;
1150 +    tm_mday := Dy;
1151 +    tm_mon := Mn - 1;
1152 +    tm_year := Yr - 1900;
1153 +  end;
1154 +  FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1155 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1156 +  isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1157 +  if Ms > 0 then
1158 +    Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1159 +  FModified := True;
1160 + end;
1161 +
1162 + procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1163 + var
1164 +  i: Integer;
1165 + begin
1166 +  if FUniqueName then
1167 +     xSetAsDateTime(value)
1168 +  else
1169    for i := 0 to FParent.FCount - 1 do
1170 <    if FParent.FNames[i] = FName then
1171 <    begin
1172 <      xvar := FParent[i];
1173 <      xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1174 <      DecodeDate(Value, Yr, Mn, Dy);
1175 <      DecodeTime(Value, Hr, Mt, S, Ms);
1176 <      with tm_date do begin
1177 <        tm_sec := S;
1178 <        tm_min := Mt;
1179 <        tm_hour := Hr;
1180 <        tm_mday := Dy;
1181 <        tm_mon := Mn - 1;
1182 <        tm_year := Yr - 1900;
1183 <      end;
1184 <      xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1064 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1065 <      isc_encode_date(@tm_date, PISC_QUAD(xvar.FXSQLVAR^.sqldata));
1066 <      xvar.FModified := True;
1067 <    end;
1170 >    if FParent[i].FName = FName then
1171 >       FParent[i].xSetAsDateTime(Value);
1172 > end;
1173 >
1174 > procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1175 > begin
1176 >  if IsNullable then
1177 >    IsNull := False;
1178 >
1179 >  FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1180 >  FXSQLVAR^.sqllen := SizeOf(Double);
1181 >  FXSQLVAR^.sqlscale := 0;
1182 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1183 >  PDouble(FXSQLVAR^.sqldata)^ := Value;
1184 >  FModified := True;
1185   end;
1186  
1187   procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1188   var
1189    i: Integer;
1190 <  xvar: TIBXSQLVAR;
1190 > begin
1191 >  if FUniqueName then
1192 >     xSetAsDouble(Value)
1193 >  else
1194 >  for i := 0 to FParent.FCount - 1 do
1195 >    if FParent[i].FName = FName then
1196 >       FParent[i].xSetAsDouble(Value);
1197 > end;
1198 >
1199 > procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1200   begin
1201    if IsNullable then
1202      IsNull := False;
1203 <  for i := 0 to FParent.FCount - 1 do
1204 <    if FParent.FNames[i] = FName then
1205 <    begin
1206 <      xvar := FParent[i];
1207 <      xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1208 <      xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1209 <      xvar.FXSQLVAR^.sqlscale := 0;
1084 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1085 <      PDouble(xvar.FXSQLVAR^.sqldata)^ := Value;
1086 <      xvar.FModified := True;
1087 <    end;
1203 >
1204 >  FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1205 >  FXSQLVAR^.sqllen := SizeOf(Float);
1206 >  FXSQLVAR^.sqlscale := 0;
1207 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1208 >  PSingle(FXSQLVAR^.sqldata)^ := Value;
1209 >  FModified := True;
1210   end;
1211  
1212   procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1213   var
1214    i: Integer;
1215 <  xvar: TIBXSQLVAR;
1215 > begin
1216 >  if FUniqueName then
1217 >     xSetAsFloat(Value)
1218 >  else
1219 >  for i := 0 to FParent.FCount - 1 do
1220 >    if FParent[i].FName = FName then
1221 >       FParent[i].xSetAsFloat(Value);
1222 > end;
1223 >
1224 > procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1225   begin
1226    if IsNullable then
1227      IsNull := False;
1228 <  for i := 0 to FParent.FCount - 1 do
1229 <    if FParent.FNames[i] = FName then
1230 <    begin
1231 <      xvar := FParent[i];
1232 <      xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1233 <      xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1234 <      xvar.FXSQLVAR^.sqlscale := 0;
1104 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1105 <      PSingle(xvar.FXSQLVAR^.sqldata)^ := Value;
1106 <      xvar.FModified := True;
1107 <    end;
1228 >
1229 >  FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1230 >  FXSQLVAR^.sqllen := SizeOf(Long);
1231 >  FXSQLVAR^.sqlscale := 0;
1232 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1233 >  PLong(FXSQLVAR^.sqldata)^ := Value;
1234 >  FModified := True;
1235   end;
1236  
1237   procedure TIBXSQLVAR.SetAsLong(Value: Long);
1238   var
1239    i: Integer;
1113 –  xvar: TIBXSQLVAR;
1240   begin
1241 <  if IsNullable then
1242 <    IsNull := False;
1241 >  if FUniqueName then
1242 >     xSetAsLong(Value)
1243 >  else
1244    for i := 0 to FParent.FCount - 1 do
1245 <    if FParent.FNames[i] = FName then
1246 <    begin
1120 <      xvar := FParent[i];
1121 <      xvar.FXSQLVAR^.sqltype := SQL_LONG or (xvar.FXSQLVAR^.sqltype and 1);
1122 <      xvar.FXSQLVAR^.sqllen := SizeOf(Long);
1123 <      xvar.FXSQLVAR^.sqlscale := 0;
1124 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1125 <      PLong(xvar.FXSQLVAR^.sqldata)^ := Value;
1126 <      xvar.FModified := True;
1127 <    end;
1245 >    if FParent[i].FName = FName then
1246 >       FParent[i].xSetAsLong(Value);
1247   end;
1248  
1249 < procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1131 < var
1132 <  i: Integer;
1133 <  xvar: TIBXSQLVAR;
1249 > procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1250   begin
1251    if IsNullable and (Value = nil) then
1252      IsNull := True
1253    else begin
1254      IsNull := False;
1255 <    for i := 0 to FParent.FCount - 1 do
1256 <      if FParent.FNames[i] = FName then
1141 <      begin
1142 <        xvar := FParent[i];
1143 <        xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1144 <        Move(Value^, xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1145 <        xvar.FModified := True;
1146 <      end;
1255 >    FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1256 >    Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1257    end;
1258 +  FModified := True;
1259 + end;
1260 +
1261 + procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1262 + var
1263 +  i: Integer;
1264 + begin
1265 +    if FUniqueName then
1266 +       xSetAsPointer(Value)
1267 +    else
1268 +    for i := 0 to FParent.FCount - 1 do
1269 +      if FParent[i].FName = FName then
1270 +         FParent[i].xSetAsPointer(Value);
1271 + end;
1272 +
1273 + procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1274 + begin
1275 +  if IsNullable then
1276 +      IsNull := False;
1277 +  if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1278 +     (FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1279 +    IBError(ibxeInvalidDataConversion, [nil]);
1280 +  FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1281 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1282 +  PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1283 +  FModified := True;
1284   end;
1285  
1286   procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1287   var
1288    i: Integer;
1289 <  xvar: TIBXSQLVAR;
1289 > begin
1290 >  if FUniqueName then
1291 >     xSetAsQuad(Value)
1292 >  else
1293 >  for i := 0 to FParent.FCount - 1 do
1294 >    if FParent[i].FName = FName then
1295 >       FParent[i].xSetAsQuad(Value);
1296 > end;
1297 >
1298 > procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1299   begin
1300    if IsNullable then
1301      IsNull := False;
1302 <  for i := 0 to FParent.FCount - 1 do
1303 <    if FParent.FNames[i] = FName then
1304 <    begin
1305 <      xvar := FParent[i];
1306 <      if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1307 <         (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1308 <        IBError(ibxeInvalidDataConversion, [nil]);
1164 <      xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1165 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1166 <      PISC_QUAD(xvar.FXSQLVAR^.sqldata)^ := Value;
1167 <      xvar.FModified := True;
1168 <    end;
1302 >
1303 >  FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1304 >  FXSQLVAR^.sqllen := SizeOf(Short);
1305 >  FXSQLVAR^.sqlscale := 0;
1306 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1307 >  PShort(FXSQLVAR^.sqldata)^ := Value;
1308 >  FModified := True;
1309   end;
1310  
1311   procedure TIBXSQLVAR.SetAsShort(Value: Short);
1312   var
1313    i: Integer;
1174 –  xvar: TIBXSQLVAR;
1314   begin
1315 <  if IsNullable then
1316 <    IsNull := False;
1315 >  if FUniqueName then
1316 >     xSetAsShort(Value)
1317 >  else
1318    for i := 0 to FParent.FCount - 1 do
1319 <    if FParent.FNames[i] = FName then
1320 <    begin
1181 <      xvar := FParent[i];
1182 <      xvar.FXSQLVAR^.sqltype := SQL_SHORT or (xvar.FXSQLVAR^.sqltype and 1);
1183 <      xvar.FXSQLVAR^.sqllen := SizeOf(Short);
1184 <      xvar.FXSQLVAR^.sqlscale := 0;
1185 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1186 <      PShort(xvar.FXSQLVAR^.sqldata)^ := Value;
1187 <      xvar.FModified := True;
1188 <    end;
1319 >    if FParent[i].FName = FName then
1320 >       FParent[i].xSetAsShort(Value);
1321   end;
1322  
1323 < procedure TIBXSQLVAR.SetAsString(Value: String);
1323 > procedure TIBXSQLVAR.xSetAsString(Value: String);
1324   var
1325 <  stype: Integer;
1326 <  ss: TStringStream;
1325 >   stype: Integer;
1326 >   ss: TStringStream;
1327  
1328 <  procedure SetStringValue;
1329 <  var
1330 <    i: Integer;
1331 <    xvar: TIBXSQLVAR;
1332 <  begin
1333 <    for i := 0 to FParent.FCount - 1 do
1334 <      if FParent.FNames[i] = FName then
1335 <      begin
1336 <        xvar := FParent[i];
1337 <        if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1338 <           (xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1339 <          Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1340 <        else begin
1209 <          xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1210 <          xvar.FXSQLVAR^.sqllen := Length(Value);
1211 <          IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen + 1);
1212 <          if (Length(Value) > 0) then
1213 <            Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1214 <        end;
1215 <        xvar.FModified := True;
1328 >   procedure SetStringValue;
1329 >   var
1330 >      i: Integer;
1331 >   begin
1332 >      if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1333 >         (FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1334 >        Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1335 >      else begin
1336 >        FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1337 >        FXSQLVAR^.sqllen := Length(Value);
1338 >        IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1339 >        if (Length(Value) > 0) then
1340 >          Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1341        end;
1342 <  end;
1342 >      FModified := True;
1343 >   end;
1344  
1345   begin
1346    if IsNullable then
1347      IsNull := False;
1348 +
1349    stype := FXSQLVAR^.sqltype and (not 1);
1350    if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1351      SetStringValue
# Line 1236 | Line 1363 | begin
1363        IsNull := True
1364      else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1365        (stype = SQL_TYPE_TIME) then
1366 <      SetAsDateTime(StrToDateTime(Value))
1366 >      xSetAsDateTime(StrToDateTime(Value))
1367      else
1368        SetStringValue;
1369    end;
1370   end;
1371  
1372 < procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1372 > procedure TIBXSQLVAR.SetAsString(Value: String);
1373 > var
1374 >   i: integer;
1375 > begin
1376 >  if FUniqueName then
1377 >     xSetAsString(Value)
1378 >  else
1379 >  for i := 0 to FParent.FCount - 1 do
1380 >    if FParent[i].FName = FName then
1381 >       FParent[i].xSetAsString(Value);
1382 > end;
1383 >
1384 > procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1385   begin
1386    if VarIsNull(Value) then
1387      IsNull := True
1388    else case VarType(Value) of
1389      varEmpty, varNull:
1390        IsNull := True;
1391 <    varSmallint, varInteger, varByte:
1391 >    varSmallint, varInteger, varByte,
1392 >      varWord, varShortInt:
1393        AsLong := Value;
1394 +    varInt64:
1395 +      AsInt64 := Value;
1396      varSingle, varDouble:
1397        AsDouble := Value;
1398      varCurrency:
# Line 1271 | Line 1413 | begin
1413    end;
1414   end;
1415  
1416 < procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1416 > procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1417 > var
1418 >   i: integer;
1419 > begin
1420 >  if FUniqueName then
1421 >     xSetAsVariant(Value)
1422 >  else
1423 >  for i := 0 to FParent.FCount - 1 do
1424 >    if FParent[i].FName = FName then
1425 >       FParent[i].xSetAsVariant(Value);
1426 > end;
1427 >
1428 > procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1429   var
1276 –  i: Integer;
1277 –  xvar: TIBXSQLVAR;
1430    sqlind: PShort;
1431    sqldata: PChar;
1432    local_sqllen: Integer;
1433   begin
1434 <  for i := 0 to FParent.FCount - 1 do
1435 <    if FParent.FNames[i] = FName then
1436 <    begin
1437 <      xvar := FParent[i];
1438 <      sqlind := xvar.FXSQLVAR^.sqlind;
1439 <      sqldata := xvar.FXSQLVAR^.sqldata;
1440 <      Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1441 <      xvar.FXSQLVAR^.sqlind := sqlind;
1442 <      xvar.FXSQLVAR^.sqldata := sqldata;
1443 <      if (Value^.sqltype and 1 = 1) then
1444 <      begin
1445 <        if (xvar.FXSQLVAR^.sqlind = nil) then
1446 <          IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1447 <        xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1448 <      end
1449 <      else
1450 <        if (xvar.FXSQLVAR^.sqlind <> nil) then
1451 <          ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1452 <      if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1453 <        local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1454 <      else
1455 <        local_sqllen := xvar.FXSQLVAR^.sqllen;
1304 <      FXSQLVAR^.sqlscale := Value^.sqlscale;
1305 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen);
1306 <      Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen);
1307 <      xvar.FModified := True;
1308 <    end;
1434 >  sqlind := FXSQLVAR^.sqlind;
1435 >  sqldata := FXSQLVAR^.sqldata;
1436 >  Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1437 >  FXSQLVAR^.sqlind := sqlind;
1438 >  FXSQLVAR^.sqldata := sqldata;
1439 >  if (Value^.sqltype and 1 = 1) then
1440 >  begin
1441 >    if (FXSQLVAR^.sqlind = nil) then
1442 >      IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1443 >    FXSQLVAR^.sqlind^ := Value^.sqlind^;
1444 >  end
1445 >  else
1446 >    if (FXSQLVAR^.sqlind <> nil) then
1447 >      ReallocMem(FXSQLVAR^.sqlind, 0);
1448 >  if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1449 >    local_sqllen := FXSQLVAR^.sqllen + 2
1450 >  else
1451 >    local_sqllen := FXSQLVAR^.sqllen;
1452 >  FXSQLVAR^.sqlscale := Value^.sqlscale;
1453 >  IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1454 >  Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1455 >  FModified := True;
1456   end;
1457  
1458 < procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1458 > procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1459   var
1460    i: Integer;
1461 <  xvar: TIBXSQLVAR;
1461 > begin
1462 >  if FUniqueName then
1463 >     xSetAsXSQLVAR(Value)
1464 >  else
1465 >  for i := 0 to FParent.FCount - 1 do
1466 >    if FParent[i].FName = FName then
1467 >       FParent[i].xSetAsXSQLVAR(Value);
1468 > end;
1469 >
1470 > procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1471   begin
1472    if Value then
1473    begin
1474      if not IsNullable then
1475        IsNullable := True;
1476 <    for i := 0 to FParent.FCount - 1 do
1477 <      if FParent.FNames[i] = FName then
1478 <      begin
1479 <        xvar := FParent[i];
1324 <        if Assigned(xvar.FXSQLVAR^.sqlind) then
1325 <          xvar.FXSQLVAR^.sqlind^ := -1;
1326 <        xvar.FModified := True;
1327 <      end;
1476 >
1477 >    if Assigned(FXSQLVAR^.sqlind) then
1478 >      FXSQLVAR^.sqlind^ := -1;
1479 >    FModified := True;
1480    end
1481    else
1482      if ((not Value) and IsNullable) then
1483      begin
1484 <      for i := 0 to FParent.FCount - 1 do
1485 <        if FParent.FNames[i] = FName then
1486 <        begin
1335 <          xvar := FParent[i];
1336 <          if Assigned(xvar.FXSQLVAR^.sqlind) then
1337 <            xvar.FXSQLVAR^.sqlind^ := 0;
1338 <          xvar.FModified := True;
1339 <        end;
1484 >      if Assigned(FXSQLVAR^.sqlind) then
1485 >        FXSQLVAR^.sqlind^ := 0;
1486 >      FModified := True;
1487      end;
1488   end;
1489  
1490 < procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1490 > procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1491   var
1492    i: Integer;
1346 –  xvar: TIBXSQLVAR;
1493   begin
1494 +  if FUniqueName then
1495 +     xSetIsNull(Value)
1496 +  else
1497    for i := 0 to FParent.FCount - 1 do
1498 <    if FParent.FNames[i] = FName then
1498 >    if FParent[i].FName = FName then
1499 >       FParent[i].xSetIsNull(Value);
1500 > end;
1501 >
1502 > procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1503 > begin
1504 >  if (Value <> IsNullable) then
1505 >  begin
1506 >    if Value then
1507      begin
1508 <      xvar := FParent[i];
1509 <      if (Value <> IsNullable) then
1510 <      begin
1511 <        if Value then
1512 <        begin
1513 <          xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1514 <          IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1358 <        end
1359 <        else
1360 <        begin
1361 <          xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1362 <          ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1363 <        end;
1364 <      end;
1508 >      FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1509 >      IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1510 >    end
1511 >    else
1512 >    begin
1513 >      FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1514 >      ReallocMem(FXSQLVAR^.sqlind, 0);
1515      end;
1516 +  end;
1517   end;
1518  
1519 + procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1520 + var
1521 +  i: Integer;
1522 + begin
1523 +  if FUniqueName then
1524 +     xSetIsNullable(Value)
1525 +  else
1526 +  for i := 0 to FParent.FCount - 1 do
1527 +    if FParent[i].FName = FName then
1528 +       FParent[i].xSetIsNullable(Value);
1529 + end;
1530 +
1531 + procedure TIBXSQLVAR.Clear;
1532 + begin
1533 +  IsNull := true;
1534 + end;
1535 +
1536 +
1537   { TIBXSQLDA }
1538 < constructor TIBXSQLDA.Create(Query: TIBSQL);
1538 > constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1539   begin
1540    inherited Create;
1541    FSQL := Query;
1373 –  FNames := TStringList.Create;
1542    FSize := 0;
1543    FUniqueRelationName := '';
1544 +  FInputSQLDA := sqldaType = daInput;
1545   end;
1546  
1547   destructor TIBXSQLDA.Destroy;
1548   var
1549    i: Integer;
1550   begin
1382 –  FNames.Free;
1551    if FXSQLDA <> nil then
1552    begin
1553      for i := 0 to FSize - 1 do
# Line 1395 | Line 1563 | begin
1563    inherited Destroy;
1564   end;
1565  
1566 < procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1566 >    procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1567 >    UniqueName: boolean);
1568   var
1569 <  fn: String;
1569 >  fn: string;
1570   begin
1571 <  fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1572 <  while FNames.Count <= Idx do
1573 <    FNames.Add('');
1574 <  FNames[Idx] := fn;
1575 <  FXSQLVARs[Idx].FName := fn;
1571 >  {$ifdef UseCaseSensitiveParamName}
1572 >  FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1573 >  {$else}
1574 >  FXSQLVARs[Idx].FName := FieldName;
1575 >  {$endif}
1576    FXSQLVARs[Idx].FIndex := Idx;
1577 +  FXSQLVARs[Idx].FUniqueName :=  UniqueName
1578   end;
1579  
1580   function TIBXSQLDA.GetModified: Boolean;
# Line 1420 | Line 1590 | begin
1590      end;
1591   end;
1592  
1423 – function TIBXSQLDA.GetNames: String;
1424 – begin
1425 –  result := FNames.Text;
1426 – end;
1427 –
1593   function TIBXSQLDA.GetRecordSize: Integer;
1594   begin
1595    result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
# Line 1452 | Line 1617 | end;
1617   function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1618   var
1619    s: String;
1620 <  i, Cnt: Integer;
1620 >  i: Integer;
1621   begin
1622 <  s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1623 <  i := 0;
1624 <  Cnt := FNames.Count;
1625 <  while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1626 <  if i = Cnt then
1627 <    result := nil
1628 <  else
1629 <    result := GetXSQLVAR(i);
1622 >  {$ifdef ALLOWDIALECT3PARAMNAMES}
1623 >  s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1624 >  {$else}
1625 >  {$ifdef UseCaseSensitiveParamName}
1626 >   s := AnsiUpperCase(Idx);
1627 >  {$else}
1628 >   s := Idx;
1629 >  {$endif}
1630 >  {$endif}
1631 >  for i := 0 to FCount - 1 do
1632 >    if Vars[i].FName = s then
1633 >    begin
1634 >         Result := FXSQLVARs[i];
1635 >         Exit;
1636 >    end;
1637 >  Result := nil;
1638   end;
1639  
1640   procedure TIBXSQLDA.Initialize;
1641 +
1642 +    function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1643 +    var
1644 +       k: integer;
1645 +    begin
1646 +         for k := 0 to limit do
1647 +             if FXSQLVARs[k].FName = idx then
1648 +             begin
1649 +                  Result := FXSQLVARs[k];
1650 +                  Exit;
1651 +             end;
1652 +         Result := nil;
1653 +    end;
1654 +
1655   var
1656    i, j, j_len: Integer;
1470 –  NamesWereEmpty: Boolean;
1657    st: String;
1658    bUnique: Boolean;
1659 +  sBaseName: string;
1660   begin
1661    bUnique := True;
1475 –  NamesWereEmpty := (FNames.Count = 0);
1662    if FXSQLDA <> nil then
1663    begin
1664      for i := 0 to FCount - 1 do
1665      begin
1666        with FXSQLVARs[i].Data^ do
1667        begin
1668 +
1669 +        {First get the unique relation name, if any}
1670 +
1671          if bUnique and (strpas(relname) <> '') then
1672          begin
1673            if FUniqueRelationName = '' then
# Line 1490 | Line 1679 | begin
1679                bUnique := False;
1680              end;
1681          end;
1682 <        if NamesWereEmpty then
1682 >
1683 >        {If an output SQLDA then copy the aliasnames to the FName list. Ensure
1684 >         that they are all upper case only and disambiguated.
1685 >        }
1686 >
1687 >        if not FInputSQLDA then
1688          begin
1689 <          st := strpas(aliasname);
1689 >          st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1690            if st = '' then
1691            begin
1692 <            st := 'F_'; {do not localize}
1692 >            sBaseName := 'F_'; {do not localize}
1693              aliasname_length := 2;
1694              j := 1; j_len := 1;
1695 <            StrPCopy(aliasname, st + IntToStr(j));
1695 >            st := sBaseName + IntToStr(j);
1696            end
1697            else
1698            begin
1505 –            StrPCopy(aliasname, st);
1699              j := 0; j_len := 0;
1700 +            sBaseName := st;
1701            end;
1702 <          while GetXSQLVARByName(strpas(aliasname)) <> nil do
1702 >
1703 >          {Look for other columns with the same name and make unique}
1704 >
1705 >          while VarByName(st,i-1) <> nil do
1706            begin
1707 <            Inc(j); j_len := Length(IntToStr(j));
1708 <            if j_len + aliasname_length > 31 then
1709 <              StrPCopy(aliasname,
1710 <                       Copy(st, 1, 31 - j_len) +
1711 <                       IntToStr(j))
1712 <            else
1516 <              StrPCopy(aliasname, st + IntToStr(j));
1707 >               Inc(j);
1708 >               j_len := Length(IntToStr(j));
1709 >               if j_len + Length(sBaseName) > 31 then
1710 >                  st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1711 >               else
1712 >                  st := sBaseName + IntToStr(j);
1713            end;
1714 <          Inc(aliasname_length, j_len);
1715 <          AddName(strpas(aliasname), i);
1714 >
1715 >          FXSQLVARs[i].FName := st;
1716          end;
1717 +
1718 +        {Finally initialise the XSQLVAR}
1719 +
1720 +        FXSQLVARs[i].FIndex := i;
1721 +
1722          case sqltype and (not 1) of
1723            SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1724            SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
# Line 1550 | Line 1751 | var
1751    i, OldSize: Integer;
1752    p : PXSQLVAR;
1753   begin
1553 –  FNames.Clear;
1754    FCount := Value;
1755    if FCount = 0 then
1756      FUniqueRelationName := ''
# Line 1587 | Line 1787 | end;
1787  
1788   destructor TIBOutputDelimitedFile.Destroy;
1789   begin
1790 < {$IFDEF LINUX}
1790 > {$IFDEF UNIX}
1791    if FHandle <> -1 then
1792       fpclose(FHandle);
1793   {$ELSE}
# Line 1603 | Line 1803 | end;
1803   procedure TIBOutputDelimitedFile.ReadyFile;
1804   var
1805    i: Integer;
1806 <  {$IFDEF LINUX}
1806 >  {$IFDEF UNIX}
1807    BytesWritten: cint;
1808    {$ELSE}
1809    BytesWritten: DWORD;
# Line 1614 | Line 1814 | begin
1814      FColDelimiter := TAB;
1815    if FRowDelimiter = '' then
1816      FRowDelimiter := CRLF;
1817 <  {$IFDEF LINUX}
1817 >  {$IFDEF UNIX}
1818    FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1819    {$ELSE}
1820    FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
# Line 1630 | Line 1830 | begin
1830        else
1831          st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1832      st := st + FRowDelimiter;
1833 <    {$IFDEF LINUX}
1833 >    {$IFDEF UNIX}
1834      if FHandle <> -1 then
1835         BytesWritten := FpWrite(FHandle,st[1],Length(st));
1836      if BytesWritten = -1 then
1837         raise Exception.Create('File Write Error');
1838      {$ELSE}
1839 <    WriteFile(FHandle, PChar(st[1]), Length(st), BytesWritten, nil);
1839 >    WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1840      {$ENDIF}
1841    end;
1842   end;
# Line 1644 | Line 1844 | end;
1844   function TIBOutputDelimitedFile.WriteColumns: Boolean;
1845   var
1846    i: Integer;
1847 <  {$IFDEF LINUX}
1847 >  {$IFDEF UNIX}
1848    BytesWritten: cint;
1849    {$ELSE}
1850    BytesWritten: DWORD;
# Line 1652 | Line 1852 | var
1852    st: string;
1853   begin
1854    result := False;
1855 <  {$IFDEF LINUX}
1855 >  {$IFDEF UNIX}
1856    if FHandle <> -1 then
1857    {$ELSE}
1858    if FHandle <> 0 then
# Line 1666 | Line 1866 | begin
1866        st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1867      end;
1868      st := st + FRowDelimiter;
1869 <  {$IFDEF LINUX}
1869 >  {$IFDEF UNIX}
1870      BytesWritten := FpWrite(FHandle,st[1],Length(st));
1871    {$ELSE}
1872      WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
# Line 1783 | Line 1983 | end;
1983   { TIBOutputRawFile }
1984   destructor TIBOutputRawFile.Destroy;
1985   begin
1986 < {$IFDEF LINUX}
1986 > {$IFDEF UNIX}
1987    if FHandle <> -1 then
1988       fpclose(FHandle);
1989   {$ELSE}
# Line 1798 | Line 1998 | end;
1998  
1999   procedure TIBOutputRawFile.ReadyFile;
2000   begin
2001 <  {$IFDEF LINUX}
2001 >  {$IFDEF UNIX}
2002    FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
2003    {$ELSE}
2004    FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
# Line 1818 | Line 2018 | begin
2018    begin
2019      for i := 0 to Columns.Count - 1 do
2020      begin
2021 <      {$IFDEF LINUX}
2021 >      {$IFDEF UNIX}
2022        BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
2023        {$ELSE}
2024        WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
# Line 1834 | Line 2034 | end;
2034   { TIBInputRawFile }
2035   destructor TIBInputRawFile.Destroy;
2036   begin
2037 < {$IFDEF LINUX}
2037 > {$IFDEF UNIX}
2038    if FHandle <> -1 then
2039       fpclose(FHandle);
2040   {$ELSE}
# Line 1850 | Line 2050 | var
2050    BytesRead: DWord;
2051   begin
2052    result := False;
2053 < {$IFDEF LINUX}
2053 > {$IFDEF UNIX}
2054    if FHandle <> -1 then
2055   {$ELSE}
2056    if FHandle <> 0 then
# Line 1858 | Line 2058 | begin
2058    begin
2059      for i := 0 to Params.Count - 1 do
2060      begin
2061 <      {$IFDEF LINUX}
2061 >      {$IFDEF UNIX}
2062        BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
2063        {$ELSE}
2064 <      ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen);
2064 >      ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
2065                 BytesRead, nil);
2066        {$ENDIF}
2067        if BytesRead <> DWORD(Params[i].Data^.sqllen) then
# Line 1873 | Line 2073 | end;
2073  
2074   procedure TIBInputRawFile.ReadyFile;
2075   begin
2076 < {$IFDEF LINUX}
2076 > {$IFDEF UNIX}
2077    if FHandle <> -1 then
2078       fpclose(FHandle);
2079    FHandle := FpOpen(Filename,O_RdOnly);
# Line 1909 | Line 2109 | begin
2109    TStringList(FSQL).OnChanging := SQLChanging;
2110    FProcessedSQL := TStringList.Create;
2111    FHandle := nil;
2112 <  FSQLParams := TIBXSQLDA.Create(self);
2113 <  FSQLRecord := TIBXSQLDA.Create(self);
2112 >  FSQLParams := TIBXSQLDA.Create(self,daInput);
2113 >  FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2114    FSQLType := SQLUnknown;
2115    FParamCheck := True;
2116    FCursor := Name + RandomString(8);
# Line 2023 | Line 2223 | begin
2223    result := FSQLRecord;
2224   end;
2225  
2226 + function TIBSQL.GetFieldCount: integer;
2227 + begin
2228 +  Result := FSQLRecord.Count
2229 + end;
2230 +
2231 + procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2232 + begin
2233 +  if FUniqueParamNames = AValue then Exit;
2234 +  FreeHandle;
2235 +  FUniqueParamNames := AValue;
2236 + end;
2237 +
2238   procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2239   begin
2240    if (FHandle <> nil) then begin
# Line 2062 | Line 2274 | begin
2274                              @FHandle,
2275                              Database.SQLDialect,
2276                              FSQLParams.AsXSQLDA,
2277 <                            FSQLRecord.AsXSQLDA), False);
2278 <      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2277 >                            FSQLRecord.AsXSQLDA), True);
2278 > (*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2279        begin
2280           { Sometimes a prepared stored procedure appears to get
2281             off sync on the server ....This code is meant to try
# Line 2078 | Line 2290 | begin
2290                              Database.SQLDialect,
2291                              FSQLParams.AsXSQLDA,
2292                              FSQLRecord.AsXSQLDA), True);
2293 <      end;
2293 >      end;  *)
2294      end
2295      else
2296        Call(isc_dsql_execute(StatusVector,
# Line 2087 | Line 2299 | begin
2299                             Database.SQLDialect,
2300                             FSQLParams.AsXSQLDA), True)
2301    end;
2090 –  {$IFDEF HAS_SQLMONITOR}
2302    if not (csDesigning in ComponentState) then
2303      MonitorHook.SQLExecute(Self);
2093 –  {$ENDIF}
2304   end;
2305  
2306   function TIBSQL.GetEOF: Boolean;
# Line 2152 | Line 2362 | begin
2362        FBOF := False;
2363        result := FSQLRecord;
2364      end;
2155 –  {$IFDEF HAS_SQLMONITOR}
2365      if not (csDesigning in ComponentState) then
2366        MonitorHook.SQLFetch(Self);
2158 –  {$ENDIF}
2367    end;
2368   end;
2369  
# Line 2222 | Line 2430 | begin
2430    result := FRecordCount;
2431   end;
2432  
2433 < function TIBSQL.GetRowsAffected: integer;
2433 > function TIBSQL.GetRowsAffected: Integer;
2434   var
2435    result_buffer: array[0..1048] of Char;
2436    info_request: Char;
# Line 2273 | Line 2481 | var
2481    cCurChar, cNextChar, cQuoteChar: Char;
2482    sSQL, sProcessedSQL, sParamName: String;
2483    i, iLenSQL, iSQLPos: Integer;
2484 <  iCurState, iCurParamState: Integer;
2484 >  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2485    iParamSuffix: Integer;
2486    slNames: TStrings;
2487  
# Line 2282 | Line 2490 | const
2490    CommentState = 1;
2491    QuoteState = 2;
2492    ParamState = 3;
2493 + {$ifdef ALLOWDIALECT3PARAMNAMES}
2494    ParamDefaultState = 0;
2495    ParamQuoteState = 1;
2496 +  {$endif}
2497  
2498    procedure AddToProcessedSQL(cChar: Char);
2499    begin
# Line 2303 | Line 2513 | begin
2513      i := 1;
2514      iSQLPos := 1;
2515      iCurState := DefaultState;
2516 +    {$ifdef ALLOWDIALECT3PARAMNAMES}
2517      iCurParamState := ParamDefaultState;
2518 +    {$endif}
2519      { Now, traverse through the SQL string, character by character,
2520       picking out the parameters and formatting correctly for InterBase }
2521      while (i <= iLenSQL) do begin
# Line 2354 | Line 2566 | begin
2566          ParamState:
2567          begin
2568            { collect the name of the parameter }
2569 +          {$ifdef ALLOWDIALECT3PARAMNAMES}
2570            if iCurParamState = ParamDefaultState then
2571            begin
2572              if cCurChar = '"' then
2573                iCurParamState := ParamQuoteState
2574 <            else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2574 >            else
2575 >            {$endif}
2576 >            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2577                  sParamName := sParamName + cCurChar
2578              else if FGenerateParamNames then
2579              begin
2580                sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2581                Inc(iParamSuffix);
2582                iCurState := DefaultState;
2583 <              slNames.Add(sParamName);
2583 >              slNames.AddObject(sParamName,self); //Note local convention
2584 >                                                  //add pointer to self to mark entry
2585                sParamName := '';
2586              end
2587              else
2588                IBError(ibxeSQLParseError, [SParamNameExpected]);
2589 +          {$ifdef ALLOWDIALECT3PARAMNAMES}
2590            end
2591            else begin
2592              { determine if Quoted parameter name is finished }
# Line 2384 | Line 2601 | begin
2601              else
2602                sParamName := sParamName + cCurChar
2603            end;
2604 +          {$endif}
2605            { determine if the unquoted parameter name is finished }
2606 <          if (iCurParamState <> ParamQuoteState) and
2606 >          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2607              (iCurState <> DefaultState) then
2608            begin
2609              if not (cNextChar in ['A'..'Z', 'a'..'z',
# Line 2405 | Line 2623 | begin
2623      AddToProcessedSQL(#0);
2624      FSQLParams.Count := slNames.Count;
2625      for i := 0 to slNames.Count - 1 do
2626 <      FSQLParams.AddName(slNames[i], i);
2626 >      FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2627      FProcessedSQL.Text := sProcessedSQL;
2628    finally
2629      slNames.Free;
# Line 2486 | Line 2704 | begin
2704        end;
2705      end;
2706      FPrepared := True;
2489 –  {$IFDEF HAS_SQLMONITOR}
2707      if not (csDesigning in ComponentState) then
2708        MonitorHook.SQLPrepare(Self);
2492 –  {$ENDIF}
2709    except
2710      on E: Exception do begin
2711        if (FHandle <> nil) then

Diff Legend

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