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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 23 by tony, Fri Mar 13 10:26:52 2015 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
27 + {    IBX For Lazarus (Firebird Express)                                  }
28 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 + {    Portions created by MWA Software are copyright McCallum Whyman      }
30 + {    Associates Ltd 2011 - 2014                                                }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBSQL;
35  
36 + {$Mode Delphi}
37 +
38 + { IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
39 +
40 + Dialect 3 quoted format parameter names represent a significant overhead and are of
41 + limited value - especially for users that use only TIBSQL or TIBCustomDataset
42 + descendents. They were previously used internally by IBX to simplify SQL generation
43 + for TTable components in Master/Slave relationships which are linked by
44 + Dialect 3 names. They were also generated by TStoredProc when the original
45 + parameter names are quoted.
46 +
47 + However, for some users they do cause a big processing overhead. The TTable/TStoredProc
48 + code has been re-written so that they are no required by IBX internally.
49 + The code to support quoted parameter names is now subject  to conditional compilation.
50 + To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled.
51 +
52 + Hint: deleting the space between the brace and the dollar sign below
53 +
54 + }
55 +
56 + { $define ALLOWDIALECT3PARAMNAMES}
57 +
58 + {$ifndef ALLOWDIALECT3PARAMNAMES}
59 +
60 + { Even when dialect 3 quoted format parameter names are not supported, IBX still processes
61 +  parameter names case insensitive. This does result in some additional overhead
62 +  due to a call to "AnsiUpperCase". This can be avoided by undefining
63 +  "UseCaseSensitiveParamName" below.
64 +
65 +  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
66 +  is defined. This will not give a useful result.
67 + }
68 + {$define UseCaseSensitiveParamName}
69 + {$endif}
70 +
71   interface
72  
73   uses
74 <  Windows, SysUtils, Classes, Forms, Controls, IBHeader,
74 > {$IFDEF WINDOWS }
75 >  Windows,
76 > {$ELSE}
77 >  baseunix, unix,
78 > {$ENDIF}
79 >  SysUtils, Classes, Forms, Controls, IBHeader,
80    IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
81  
82 + const
83 +   sSQLErrorSeparator = ' When Executing: ';
84 +
85   type
86    TIBSQL = class;
87    TIBXSQLDA = class;
# Line 46 | Line 94 | type
94      FIndex: Integer;
95      FModified: Boolean;
96      FName: String;
97 +    FUniqueName: boolean;
98      FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
99  
100      function AdjustScale(Value: Int64; Scale: Integer): Double;
101      function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
102      function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
103 +    function GetAsBoolean: boolean;
104      function GetAsCurrency: Currency;
105      function GetAsInt64: Int64;
106      function GetAsDateTime: TDateTime;
# Line 67 | Line 117 | type
117      function GetIsNullable: Boolean;
118      function GetSize: Integer;
119      function GetSQLType: Integer;
120 +    procedure SetAsBoolean(AValue: boolean);
121      procedure SetAsCurrency(Value: Currency);
122      procedure SetAsInt64(Value: Int64);
123      procedure SetAsDate(Value: TDateTime);
124 +    procedure SetAsLong(Value: Long);
125      procedure SetAsTime(Value: TDateTime);
126      procedure SetAsDateTime(Value: TDateTime);
127      procedure SetAsDouble(Value: Double);
128      procedure SetAsFloat(Value: Float);
77 –    procedure SetAsLong(Value: Long);
129      procedure SetAsPointer(Value: Pointer);
130      procedure SetAsQuad(Value: TISC_QUAD);
131      procedure SetAsShort(Value: Short);
# Line 83 | Line 134 | type
134      procedure SetAsXSQLVAR(Value: PXSQLVAR);
135      procedure SetIsNull(Value: Boolean);
136      procedure SetIsNullable(Value: Boolean);
137 +    procedure xSetAsBoolean(AValue: boolean);
138 +    procedure xSetAsCurrency(Value: Currency);
139 +    procedure xSetAsInt64(Value: Int64);
140 +    procedure xSetAsDate(Value: TDateTime);
141 +    procedure xSetAsTime(Value: TDateTime);
142 +    procedure xSetAsDateTime(Value: TDateTime);
143 +    procedure xSetAsDouble(Value: Double);
144 +    procedure xSetAsFloat(Value: Float);
145 +    procedure xSetAsLong(Value: Long);
146 +    procedure xSetAsPointer(Value: Pointer);
147 +    procedure xSetAsQuad(Value: TISC_QUAD);
148 +    procedure xSetAsShort(Value: Short);
149 +    procedure xSetAsString(Value: String);
150 +    procedure xSetAsVariant(Value: Variant);
151 +    procedure xSetAsXSQLVAR(Value: PXSQLVAR);
152 +    procedure xSetIsNull(Value: Boolean);
153 +    procedure xSetIsNullable(Value: Boolean);
154    public
155      constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
156      procedure Assign(Source: TIBXSQLVAR);
157 +    procedure Clear;
158      procedure LoadFromFile(const FileName: String);
159      procedure LoadFromStream(Stream: TStream);
160      procedure SaveToFile(const FileName: String);
161      procedure SaveToStream(Stream: TStream);
162      property AsDate: TDateTime read GetAsDateTime write SetAsDate;
163 +    property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
164      property AsTime: TDateTime read GetAsDateTime write SetAsTime;
165      property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
166      property AsDouble: Double read GetAsDouble write SetAsDouble;
# Line 118 | Line 188 | type
188  
189    TIBXSQLVARArray = Array of TIBXSQLVAR;
190  
191 <  { TIBXSQLVAR }
191 >  TIBXSQLDAType = (daInput,daOutput);
192 >
193 >  { TIBXSQLDA }
194 >
195    TIBXSQLDA = class(TObject)
196    protected
197      FSQL: TIBSQL;
198      FCount: Integer;
126 –    FNames: TStrings;
199      FSize: Integer;
200 +    FInputSQLDA: boolean;
201      FXSQLDA: PXSQLDA;
202      FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
203      FUniqueRelationName: String;
204      function GetModified: Boolean;
132 –    function GetNames: String;
205      function GetRecordSize: Integer;
206      function GetXSQLDA: PXSQLDA;
207      function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
# Line 137 | Line 209 | type
209      procedure Initialize;
210      procedure SetCount(Value: Integer);
211    public
212 <    constructor Create(Query: TIBSQL);
212 >    constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
213      destructor Destroy; override;
214 <    procedure AddName(FieldName: String; Idx: Integer);
214 >     procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
215      function ByName(Idx: String): TIBXSQLVAR;
216      property AsXSQLDA: PXSQLDA read GetXSQLDA;
217      property Count: Integer read FCount write SetCount;
218      property Modified: Boolean read GetModified;
147 –    property Names: String read GetNames;
219      property RecordSize: Integer read GetRecordSize;
220      property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
221      property UniqueRelationName: String read FUniqueRelationName;
# Line 178 | Line 249 | type
249    { TIBOutputDelimitedFile }
250    TIBOutputDelimitedFile = class(TIBBatchOutput)
251    protected
252 +  {$IFDEF UNIX}
253 +    FHandle: cint;
254 +  {$ELSE}
255      FHandle: THandle;
256 +  {$ENDIF}
257      FOutputTitles: Boolean;
258      FColDelimiter,
259      FRowDelimiter: string;
# Line 217 | Line 292 | type
292    { TIBOutputRawFile }
293    TIBOutputRawFile = class(TIBBatchOutput)
294    protected
295 +  {$IFDEF UNIX}
296 +    FHandle: cint;
297 +  {$ELSE}
298      FHandle: THandle;
299 +  {$ENDIF}
300    public
301      destructor Destroy; override;
302      procedure ReadyFile; override;
# Line 227 | Line 306 | type
306    { TIBInputRawFile }
307    TIBInputRawFile = class(TIBBatchInput)
308    protected
309 +   {$IFDEF UNIX}
310 +    FHandle: cint;
311 +  {$ELSE}
312      FHandle: THandle;
313 +  {$ENDIF}
314    public
315      destructor Destroy; override;
316      function ReadParameters: Boolean; override;
# Line 245 | Line 328 | type
328    TIBSQL = class(TComponent)
329    private
330      FIBLoaded: Boolean;
331 +    FUniqueParamNames: Boolean;
332 +    function GetFieldCount: integer;
333 +    procedure SetUniqueParamNames(AValue: Boolean);
334    protected
335      FBase: TIBBase;
336      FBOF,                          { At BOF? }
# Line 294 | Line 380 | type
380      function Current: TIBXSQLDA;
381      procedure ExecQuery;
382      function FieldByName(FieldName: String): TIBXSQLVAR;
383 +    function ParamByName(ParamName: String): TIBXSQLVAR;
384      procedure FreeHandle;
385      function Next: TIBXSQLDA;
386      procedure Prepare;
# Line 303 | Line 390 | type
390      property Eof: Boolean read GetEOF;
391      property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
392      property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
393 +    property FieldCount: integer read GetFieldCount;
394      property Open: Boolean read FOpen;
395      property Params: TIBXSQLDA read GetSQLParams;
396      property Plan: String read GetPlan;
# Line 312 | Line 400 | type
400      property SQLType: TIBSQLTypes read FSQLType;
401      property TRHandle: PISC_TR_HANDLE read GetTRHandle;
402      property Handle: TISC_STMT_HANDLE read FHandle;
315 –    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
403      property UniqueRelationName: String read GetUniqueRelationName;
404    published
405      property Database: TIBDatabase read GetDatabase write SetDatabase;
406 +    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
407 +    property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
408      property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
409                                                 write FGoToFirstRecordOnExecute
410                                                 default True;
# Line 328 | Line 417 | type
417   implementation
418  
419   uses
420 <  IBIntf, IBBlob, IBSQLMonitor;
420 >  IBIntf, IBBlob, Variants , IBSQLMonitor;
421  
422   { TIBXSQLVAR }
423   constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
# Line 343 | Line 432 | var
432    szBuff: PChar;
433    s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
434    bSourceBlob, bDestBlob: Boolean;
435 <  iSegs, iMaxSeg, iSize: Long;
435 >  iSegs: Int64;
436 >  iMaxSeg: Int64;
437 >  iSize: Int64;
438    iBlobType: Short;
439   begin
440    szBuff := nil;
# Line 405 | Line 496 | begin
496          0, nil), True);
497        try
498          IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
499 +        isNull := false
500        finally
501          FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
502        end;
# Line 424 | Line 516 | end;
516  
517   function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
518   var
519 <  Scaling, i: Integer;
519 >  Scaling : Int64;
520 >  i: Integer;
521    Val: Double;
522   begin
523    Scaling := 1; Val := Value;
# Line 447 | Line 540 | end;
540  
541   function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
542   var
543 <  Scaling, i: Integer;
543 >  Scaling : Int64;
544 >  i: Integer;
545    Val: Int64;
546   begin
547    Scaling := 1; Val := Value;
# Line 463 | Line 557 | end;
557  
558   function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
559   var
560 <  Scaling, i : Integer;
560 >  Scaling : Int64;
561 >  i : Integer;
562    FractionText, PadText, CurrText: string;
563   begin
564 <  result := Value;
564 >  Result := 0;
565    Scaling := 1;
566    if Scale > 0 then
567    begin
# Line 489 | Line 584 | begin
584        try
585          result := StrToCurr(CurrText);
586        except
587 <        on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
587 >        on E: Exception do
588 >          IBError(ibxeInvalidDataConversion, [nil]);
589        end;
590 <    end;
590 >    end
591 >    else
592 >      result := Value;
593 > end;
594 >
595 > function TIBXSQLVAR.GetAsBoolean: boolean;
596 > begin
597 >  result := false;
598 >  if not IsNull then
599 >  begin
600 >    if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
601 >      result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
602 >    else
603 >      IBError(ibxeInvalidDataConversion, [nil]);
604 >  end
605   end;
606  
607   function TIBXSQLVAR.GetAsCurrency: Currency;
# Line 557 | Line 667 | end;
667   function TIBXSQLVAR.GetAsDateTime: TDateTime;
668   var
669    tm_date: TCTimeStructure;
670 +  msecs: word;
671   begin
672    result := 0;
673    if not IsNull then
# Line 582 | Line 693 | begin
693        SQL_TYPE_TIME: begin
694          isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
695          try
696 +          msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
697            result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
698 <                               Word(tm_date.tm_sec), 0)
698 >                               Word(tm_date.tm_sec), msecs)
699          except
700            on E: EConvertError do begin
701              IBError(ibxeInvalidDataConversion, [nil]);
# Line 595 | Line 707 | begin
707          try
708            result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
709                                Word(tm_date.tm_mday));
710 +          msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
711            if result >= 0 then
712              result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
713 <                                          Word(tm_date.tm_sec), 0)
713 >                                          Word(tm_date.tm_sec), msecs)
714            else
715              result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
716 <                                          Word(tm_date.tm_sec), 0)
716 >                                          Word(tm_date.tm_sec), msecs)
717          except
718            on E: EConvertError do begin
719              IBError(ibxeInvalidDataConversion, [nil]);
# Line 730 | Line 843 | begin
843          result := '(Array)'; {do not localize}
844        SQL_BLOB: begin
845          ss := TStringStream.Create('');
846 <        SaveToStream(ss);
847 <        result := ss.DataString;
848 <        ss.Free;
846 >        try
847 >          SaveToStream(ss);
848 >          result := ss.DataString;
849 >        finally
850 >          ss.Free;
851 >        end;
852        end;
853        SQL_TEXT, SQL_VARYING: begin
854          sz := FXSQLVAR^.sqldata;
# Line 799 | Line 915 | begin
915            result := AsDouble;
916        SQL_INT64:
917          if FXSQLVAR^.sqlscale = 0 then
918 <          IBError(ibxeInvalidDataConversion, [nil])
918 >          result := AsInt64
919          else if FXSQLVAR^.sqlscale >= (-4) then
920            result := AsCurrency
921          else
922            result := AsDouble;
923        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
924          result := AsDouble;
925 +      SQL_BOOLEAN:
926 +        result := AsBoolean;
927        else
928          IBError(ibxeInvalidDataConversion, [nil]);
929      end;
# Line 894 | Line 1012 | begin
1012    result := FXSQLVAR^.sqltype and (not 1);
1013   end;
1014  
1015 + procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1016 + var
1017 +  i: Integer;
1018 + begin
1019 +  if FUniqueName then
1020 +     xSetAsBoolean(AValue)
1021 +  else
1022 +  for i := 0 to FParent.FCount - 1 do
1023 +    if FParent[i].FName = FName then
1024 +       FParent[i].xSetAsBoolean(AValue);
1025 + end;
1026 +
1027 + procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1028 + begin
1029 +  if IsNullable then
1030 +    IsNull := False;
1031 +  FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1032 +  FXSQLVAR^.sqlscale := -4;
1033 +  FXSQLVAR^.sqllen := SizeOf(Int64);
1034 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1035 +  PCurrency(FXSQLVAR^.sqldata)^ := Value;
1036 +  FModified := True;
1037 + end;
1038 +
1039   procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1040   var
899 –  xvar: TIBXSQLVAR;
1041    i: Integer;
1042   begin
1043    if FSQL.Database.SQLDialect < 3 then
1044      AsDouble := Value
1045    else
1046    begin
1047 <    if IsNullable then
1048 <      IsNull := False;
1047 >
1048 >    if FUniqueName then
1049 >       xSetAsCurrency(Value)
1050 >    else
1051      for i := 0 to FParent.FCount - 1 do
1052 <      if FParent.FNames[i] = FName then
1053 <      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;
1052 >      if FParent[i].FName = FName then
1053 >           FParent[i].xSetAsCurrency(Value);
1054    end;
1055   end;
1056  
1057 + procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1058 + begin
1059 +  if IsNullable then
1060 +    IsNull := False;
1061 +
1062 +  FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1063 +  FXSQLVAR^.sqlscale := 0;
1064 +  FXSQLVAR^.sqllen := SizeOf(Int64);
1065 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1066 +  PInt64(FXSQLVAR^.sqldata)^ := Value;
1067 +  FModified := True;
1068 + end;
1069 +
1070   procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1071   var
1072    i: Integer;
1073 <  xvar: TIBXSQLVAR;
1073 > begin
1074 >  if FUniqueName then
1075 >     xSetAsInt64(Value)
1076 >  else
1077 >  for i := 0 to FParent.FCount - 1 do
1078 >    if FParent[i].FName = FName then
1079 >          FParent[i].xSetAsInt64(Value);
1080 > end;
1081 >
1082 > procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1083 > var
1084 >   tm_date: TCTimeStructure;
1085 >   Yr, Mn, Dy: Word;
1086   begin
1087    if IsNullable then
1088      IsNull := False;
1089 <  for i := 0 to FParent.FCount - 1 do
1090 <    if FParent.FNames[i] = FName then
1091 <    begin
1092 <      xvar := FParent[i];
1093 <      xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
1094 <      xvar.FXSQLVAR^.sqlscale := 0;
1095 <      xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
1096 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1097 <      PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
1098 <      xvar.FModified := True;
1099 <    end;
1089 >
1090 >  FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1091 >  DecodeDate(Value, Yr, Mn, Dy);
1092 >  with tm_date do begin
1093 >    tm_sec := 0;
1094 >    tm_min := 0;
1095 >    tm_hour := 0;
1096 >    tm_mday := Dy;
1097 >    tm_mon := Mn - 1;
1098 >    tm_year := Yr - 1900;
1099 >  end;
1100 >  FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1101 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1102 >  isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1103 >  FModified := True;
1104   end;
1105  
1106   procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1107   var
1108    i: Integer;
945 –  tm_date: TCTimeStructure;
946 –  Yr, Mn, Dy: Word;
947 –  xvar: TIBXSQLVAR;
1109   begin
1110    if FSQL.Database.SQLDialect < 3 then
1111    begin
1112      AsDateTime := Value;
1113      exit;
1114    end;
1115 +
1116 +  if FUniqueName then
1117 +     xSetAsDate(Value)
1118 +  else
1119 +  for i := 0 to FParent.FCount - 1 do
1120 +    if FParent[i].FName = FName then
1121 +       FParent[i].xSetAsDate(Value);
1122 + end;
1123 +
1124 + procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1125 + var
1126 +  tm_date: TCTimeStructure;
1127 +  Hr, Mt, S, Ms: Word;
1128 + begin
1129    if IsNullable then
1130      IsNull := False;
1131 <  for i := 0 to FParent.FCount - 1 do
1132 <    if FParent.FNames[i] = FName then
1133 <    begin
1134 <      xvar := FParent[i];
1135 <      xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1136 <      DecodeDate(Value, Yr, Mn, Dy);
1137 <      with tm_date do begin
1138 <        tm_sec := 0;
1139 <        tm_min := 0;
1140 <        tm_hour := 0;
1141 <        tm_mday := Dy;
1142 <        tm_mon := Mn - 1;
1143 <        tm_year := Yr - 1900;
1144 <      end;
1145 <      xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1146 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1147 <      isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
973 <      xvar.FModified := True;
974 <    end;
1131 >
1132 >  FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1133 >  DecodeTime(Value, Hr, Mt, S, Ms);
1134 >  with tm_date do begin
1135 >    tm_sec := S;
1136 >    tm_min := Mt;
1137 >    tm_hour := Hr;
1138 >    tm_mday := 0;
1139 >    tm_mon := 0;
1140 >    tm_year := 0;
1141 >  end;
1142 >  FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1143 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1144 >  isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1145 >  if Ms > 0 then
1146 >    Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1147 >  FModified := True;
1148   end;
1149  
1150   procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1151   var
1152    i: Integer;
980 –  tm_date: TCTimeStructure;
981 –  Hr, Mt, S, Ms: Word;
982 –  xvar: TIBXSQLVAR;
1153   begin
1154    if FSQL.Database.SQLDialect < 3 then
1155    begin
1156      AsDateTime := Value;
1157      exit;
1158    end;
1159 <  if IsNullable then
1160 <    IsNull := False;
1159 >
1160 >  if FUniqueName then
1161 >     xSetAsTime(Value)
1162 >  else
1163    for i := 0 to FParent.FCount - 1 do
1164 <    if FParent.FNames[i] = FName then
1165 <    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;
1164 >    if FParent[i].FName = FName then
1165 >       FParent[i].xSetAsTime(Value);
1166   end;
1167  
1168 < procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1168 > procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1169   var
1014 –  i: Integer;
1170    tm_date: TCTimeStructure;
1171    Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1017 –  xvar: TIBXSQLVAR;
1172   begin
1173    if IsNullable then
1174      IsNull := False;
1175 +
1176 +  FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1177 +  DecodeDate(Value, Yr, Mn, Dy);
1178 +  DecodeTime(Value, Hr, Mt, S, Ms);
1179 +  with tm_date do begin
1180 +    tm_sec := S;
1181 +    tm_min := Mt;
1182 +    tm_hour := Hr;
1183 +    tm_mday := Dy;
1184 +    tm_mon := Mn - 1;
1185 +    tm_year := Yr - 1900;
1186 +  end;
1187 +  FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1188 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1189 +  isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1190 +  if Ms > 0 then
1191 +    Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1192 +  FModified := True;
1193 + end;
1194 +
1195 + procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1196 + var
1197 +  i: Integer;
1198 + begin
1199 +  if FUniqueName then
1200 +     xSetAsDateTime(value)
1201 +  else
1202    for i := 0 to FParent.FCount - 1 do
1203 <    if FParent.FNames[i] = FName then
1204 <    begin
1205 <      xvar := FParent[i];
1206 <      xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1207 <      DecodeDate(Value, Yr, Mn, Dy);
1208 <      DecodeTime(Value, Hr, Mt, S, Ms);
1209 <      with tm_date do begin
1210 <        tm_sec := S;
1211 <        tm_min := Mt;
1212 <        tm_hour := Hr;
1213 <        tm_mday := Dy;
1214 <        tm_mon := Mn - 1;
1215 <        tm_year := Yr - 1900;
1216 <      end;
1217 <      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;
1203 >    if FParent[i].FName = FName then
1204 >       FParent[i].xSetAsDateTime(Value);
1205 > end;
1206 >
1207 > procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1208 > begin
1209 >  if IsNullable then
1210 >    IsNull := False;
1211 >
1212 >  FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1213 >  FXSQLVAR^.sqllen := SizeOf(Double);
1214 >  FXSQLVAR^.sqlscale := 0;
1215 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1216 >  PDouble(FXSQLVAR^.sqldata)^ := Value;
1217 >  FModified := True;
1218   end;
1219  
1220   procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1221   var
1222    i: Integer;
1223 <  xvar: TIBXSQLVAR;
1223 > begin
1224 >  if FUniqueName then
1225 >     xSetAsDouble(Value)
1226 >  else
1227 >  for i := 0 to FParent.FCount - 1 do
1228 >    if FParent[i].FName = FName then
1229 >       FParent[i].xSetAsDouble(Value);
1230 > end;
1231 >
1232 > procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1233   begin
1234    if IsNullable then
1235      IsNull := False;
1236 <  for i := 0 to FParent.FCount - 1 do
1237 <    if FParent.FNames[i] = FName then
1238 <    begin
1239 <      xvar := FParent[i];
1240 <      xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1241 <      xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1242 <      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;
1236 >
1237 >  FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1238 >  FXSQLVAR^.sqllen := SizeOf(Float);
1239 >  FXSQLVAR^.sqlscale := 0;
1240 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1241 >  PSingle(FXSQLVAR^.sqldata)^ := Value;
1242 >  FModified := True;
1243   end;
1244  
1245   procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1246   var
1247    i: Integer;
1248 <  xvar: TIBXSQLVAR;
1248 > begin
1249 >  if FUniqueName then
1250 >     xSetAsFloat(Value)
1251 >  else
1252 >  for i := 0 to FParent.FCount - 1 do
1253 >    if FParent[i].FName = FName then
1254 >       FParent[i].xSetAsFloat(Value);
1255 > end;
1256 >
1257 > procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1258   begin
1259    if IsNullable then
1260      IsNull := False;
1261 <  for i := 0 to FParent.FCount - 1 do
1262 <    if FParent.FNames[i] = FName then
1263 <    begin
1264 <      xvar := FParent[i];
1265 <      xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1266 <      xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1267 <      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;
1261 >
1262 >  FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1263 >  FXSQLVAR^.sqllen := SizeOf(Long);
1264 >  FXSQLVAR^.sqlscale := 0;
1265 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1266 >  PLong(FXSQLVAR^.sqldata)^ := Value;
1267 >  FModified := True;
1268   end;
1269  
1270   procedure TIBXSQLVAR.SetAsLong(Value: Long);
1271   var
1272    i: Integer;
1086 –  xvar: TIBXSQLVAR;
1273   begin
1274 <  if IsNullable then
1275 <    IsNull := False;
1274 >  if FUniqueName then
1275 >     xSetAsLong(Value)
1276 >  else
1277    for i := 0 to FParent.FCount - 1 do
1278 <    if FParent.FNames[i] = FName then
1279 <    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;
1278 >    if FParent[i].FName = FName then
1279 >       FParent[i].xSetAsLong(Value);
1280   end;
1281  
1282 < procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1104 < var
1105 <  i: Integer;
1106 <  xvar: TIBXSQLVAR;
1282 > procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1283   begin
1284    if IsNullable and (Value = nil) then
1285      IsNull := True
1286    else begin
1287      IsNull := False;
1288 <    for i := 0 to FParent.FCount - 1 do
1289 <      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;
1288 >    FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1289 >    Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1290    end;
1291 +  FModified := True;
1292 + end;
1293 +
1294 + procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1295 + var
1296 +  i: Integer;
1297 + begin
1298 +    if FUniqueName then
1299 +       xSetAsPointer(Value)
1300 +    else
1301 +    for i := 0 to FParent.FCount - 1 do
1302 +      if FParent[i].FName = FName then
1303 +         FParent[i].xSetAsPointer(Value);
1304 + end;
1305 +
1306 + procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1307 + begin
1308 +  if IsNullable then
1309 +      IsNull := False;
1310 +  if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1311 +     (FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1312 +    IBError(ibxeInvalidDataConversion, [nil]);
1313 +  FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1314 +  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1315 +  PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1316 +  FModified := True;
1317   end;
1318  
1319   procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1320   var
1321    i: Integer;
1322 <  xvar: TIBXSQLVAR;
1322 > begin
1323 >  if FUniqueName then
1324 >     xSetAsQuad(Value)
1325 >  else
1326 >  for i := 0 to FParent.FCount - 1 do
1327 >    if FParent[i].FName = FName then
1328 >       FParent[i].xSetAsQuad(Value);
1329 > end;
1330 >
1331 > procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1332   begin
1333    if IsNullable then
1334      IsNull := False;
1335 <  for i := 0 to FParent.FCount - 1 do
1336 <    if FParent.FNames[i] = FName then
1337 <    begin
1338 <      xvar := FParent[i];
1339 <      if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1340 <         (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1341 <        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;
1335 >
1336 >  FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1337 >  FXSQLVAR^.sqllen := SizeOf(Short);
1338 >  FXSQLVAR^.sqlscale := 0;
1339 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1340 >  PShort(FXSQLVAR^.sqldata)^ := Value;
1341 >  FModified := True;
1342   end;
1343  
1344   procedure TIBXSQLVAR.SetAsShort(Value: Short);
1345   var
1346    i: Integer;
1147 –  xvar: TIBXSQLVAR;
1347   begin
1348 <  if IsNullable then
1349 <    IsNull := False;
1348 >  if FUniqueName then
1349 >     xSetAsShort(Value)
1350 >  else
1351    for i := 0 to FParent.FCount - 1 do
1352 <    if FParent.FNames[i] = FName then
1353 <    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;
1352 >    if FParent[i].FName = FName then
1353 >       FParent[i].xSetAsShort(Value);
1354   end;
1355  
1356 < procedure TIBXSQLVAR.SetAsString(Value: String);
1356 > procedure TIBXSQLVAR.xSetAsString(Value: String);
1357   var
1358 <  stype: Integer;
1359 <  ss: TStringStream;
1358 >   stype: Integer;
1359 >   ss: TStringStream;
1360  
1361 <  procedure SetStringValue;
1362 <  var
1363 <    i: Integer;
1364 <    xvar: TIBXSQLVAR;
1365 <  begin
1366 <    for i := 0 to FParent.FCount - 1 do
1367 <      if FParent.FNames[i] = FName then
1368 <      begin
1369 <        xvar := FParent[i];
1370 <        if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1371 <           (xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1372 <          Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1373 <        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;
1361 >   procedure SetStringValue;
1362 >   var
1363 >      i: Integer;
1364 >   begin
1365 >      if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1366 >         (FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1367 >        Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1368 >      else begin
1369 >        FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1370 >        FXSQLVAR^.sqllen := Length(Value);
1371 >        IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1372 >        if (Length(Value) > 0) then
1373 >          Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1374        end;
1375 <  end;
1375 >      FModified := True;
1376 >   end;
1377  
1378   begin
1379    if IsNullable then
1380      IsNull := False;
1381 +
1382    stype := FXSQLVAR^.sqltype and (not 1);
1383    if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1384      SetStringValue
# Line 1209 | Line 1396 | begin
1396        IsNull := True
1397      else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1398        (stype = SQL_TYPE_TIME) then
1399 <      SetAsDateTime(StrToDateTime(Value))
1399 >      xSetAsDateTime(StrToDateTime(Value))
1400      else
1401        SetStringValue;
1402    end;
1403   end;
1404  
1405 < procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1405 > procedure TIBXSQLVAR.SetAsString(Value: String);
1406 > var
1407 >   i: integer;
1408 > begin
1409 >  if FUniqueName then
1410 >     xSetAsString(Value)
1411 >  else
1412 >  for i := 0 to FParent.FCount - 1 do
1413 >    if FParent[i].FName = FName then
1414 >       FParent[i].xSetAsString(Value);
1415 > end;
1416 >
1417 > procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1418   begin
1419    if VarIsNull(Value) then
1420      IsNull := True
1421    else case VarType(Value) of
1422      varEmpty, varNull:
1423        IsNull := True;
1424 <    varSmallint, varInteger, varByte:
1424 >    varSmallint, varInteger, varByte,
1425 >      varWord, varShortInt:
1426        AsLong := Value;
1427 +    varInt64:
1428 +      AsInt64 := Value;
1429      varSingle, varDouble:
1430        AsDouble := Value;
1431      varCurrency:
# Line 1244 | Line 1446 | begin
1446    end;
1447   end;
1448  
1449 < procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1449 > procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1450 > var
1451 >   i: integer;
1452 > begin
1453 >  if FUniqueName then
1454 >     xSetAsVariant(Value)
1455 >  else
1456 >  for i := 0 to FParent.FCount - 1 do
1457 >    if FParent[i].FName = FName then
1458 >       FParent[i].xSetAsVariant(Value);
1459 > end;
1460 >
1461 > procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1462   var
1249 –  i: Integer;
1250 –  xvar: TIBXSQLVAR;
1463    sqlind: PShort;
1464    sqldata: PChar;
1465    local_sqllen: Integer;
1466   begin
1467 <  for i := 0 to FParent.FCount - 1 do
1468 <    if FParent.FNames[i] = FName then
1469 <    begin
1470 <      xvar := FParent[i];
1471 <      sqlind := xvar.FXSQLVAR^.sqlind;
1472 <      sqldata := xvar.FXSQLVAR^.sqldata;
1473 <      Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1474 <      xvar.FXSQLVAR^.sqlind := sqlind;
1475 <      xvar.FXSQLVAR^.sqldata := sqldata;
1476 <      if (Value^.sqltype and 1 = 1) then
1477 <      begin
1478 <        if (xvar.FXSQLVAR^.sqlind = nil) then
1479 <          IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1480 <        xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1481 <      end
1482 <      else
1483 <        if (xvar.FXSQLVAR^.sqlind <> nil) then
1484 <          ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1485 <      if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1486 <        local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1487 <      else
1488 <        local_sqllen := xvar.FXSQLVAR^.sqllen;
1277 <      FXSQLVAR^.sqlscale := Value^.sqlscale;
1278 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen);
1279 <      Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen);
1280 <      xvar.FModified := True;
1281 <    end;
1467 >  sqlind := FXSQLVAR^.sqlind;
1468 >  sqldata := FXSQLVAR^.sqldata;
1469 >  Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1470 >  FXSQLVAR^.sqlind := sqlind;
1471 >  FXSQLVAR^.sqldata := sqldata;
1472 >  if (Value^.sqltype and 1 = 1) then
1473 >  begin
1474 >    if (FXSQLVAR^.sqlind = nil) then
1475 >      IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1476 >    FXSQLVAR^.sqlind^ := Value^.sqlind^;
1477 >  end
1478 >  else
1479 >    if (FXSQLVAR^.sqlind <> nil) then
1480 >      ReallocMem(FXSQLVAR^.sqlind, 0);
1481 >  if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1482 >    local_sqllen := FXSQLVAR^.sqllen + 2
1483 >  else
1484 >    local_sqllen := FXSQLVAR^.sqllen;
1485 >  FXSQLVAR^.sqlscale := Value^.sqlscale;
1486 >  IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1487 >  Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1488 >  FModified := True;
1489   end;
1490  
1491 < procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1491 > procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1492   var
1493    i: Integer;
1494 <  xvar: TIBXSQLVAR;
1494 > begin
1495 >  if FUniqueName then
1496 >     xSetAsXSQLVAR(Value)
1497 >  else
1498 >  for i := 0 to FParent.FCount - 1 do
1499 >    if FParent[i].FName = FName then
1500 >       FParent[i].xSetAsXSQLVAR(Value);
1501 > end;
1502 >
1503 > procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1504   begin
1505    if Value then
1506    begin
1507      if not IsNullable then
1508        IsNullable := True;
1509 <    for i := 0 to FParent.FCount - 1 do
1510 <      if FParent.FNames[i] = FName then
1511 <      begin
1512 <        xvar := FParent[i];
1513 <        xvar.FXSQLVAR^.sqlind^ := -1;
1514 <        xvar.FModified := True;
1515 <      end;
1516 <  end else if ((not Value) and IsNullable) then
1509 >
1510 >    if Assigned(FXSQLVAR^.sqlind) then
1511 >      FXSQLVAR^.sqlind^ := -1;
1512 >    FModified := True;
1513 >  end
1514 >  else
1515 >    if ((not Value) and IsNullable) then
1516 >    begin
1517 >      if Assigned(FXSQLVAR^.sqlind) then
1518 >        FXSQLVAR^.sqlind^ := 0;
1519 >      FModified := True;
1520 >    end;
1521 > end;
1522 >
1523 > procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1524 > var
1525 >  i: Integer;
1526 > begin
1527 >  if FUniqueName then
1528 >     xSetIsNull(Value)
1529 >  else
1530 >  for i := 0 to FParent.FCount - 1 do
1531 >    if FParent[i].FName = FName then
1532 >       FParent[i].xSetIsNull(Value);
1533 > end;
1534 >
1535 > procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1536 > begin
1537 >  if (Value <> IsNullable) then
1538    begin
1539 <    for i := 0 to FParent.FCount - 1 do
1540 <      if FParent.FNames[i] = FName then
1541 <      begin
1542 <        xvar := FParent[i];
1543 <        xvar.FXSQLVAR^.sqlind^ := 0;
1544 <        xvar.FModified := True;
1545 <      end;
1539 >    if Value then
1540 >    begin
1541 >      FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1542 >      IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1543 >    end
1544 >    else
1545 >    begin
1546 >      FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1547 >      ReallocMem(FXSQLVAR^.sqlind, 0);
1548 >    end;
1549    end;
1550   end;
1551  
1552   procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1553   var
1554    i: Integer;
1315 –  xvar: TIBXSQLVAR;
1555   begin
1556 +  if FUniqueName then
1557 +     xSetIsNullable(Value)
1558 +  else
1559    for i := 0 to FParent.FCount - 1 do
1560 <    if FParent.FNames[i] = FName then
1561 <    begin
1562 <      xvar := FParent[i];
1563 <      if (Value <> IsNullable) then
1564 <      begin
1565 <        if Value then
1566 <        begin
1567 <          xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1568 <          IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1569 <        end
1570 <        else
1571 <        begin
1572 <          xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1573 <          ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1574 <        end;
1575 <      end;
1576 <    end;
1560 >    if FParent[i].FName = FName then
1561 >       FParent[i].xSetIsNullable(Value);
1562 > end;
1563 >
1564 > procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1565 > begin
1566 >  if IsNullable then
1567 >    IsNull := False;
1568 >
1569 >  FXSQLVAR^.sqltype := SQL_BOOLEAN;
1570 >  FXSQLVAR^.sqllen := 1;
1571 >  FXSQLVAR^.sqlscale := 0;
1572 >  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1573 >  if AValue then
1574 >    PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1575 >  else
1576 >    PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1577 >  FModified := True;
1578   end;
1579  
1580 + procedure TIBXSQLVAR.Clear;
1581 + begin
1582 +  IsNull := true;
1583 + end;
1584 +
1585 +
1586   { TIBXSQLDA }
1587 < constructor TIBXSQLDA.Create(Query: TIBSQL);
1587 > constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1588   begin
1589    inherited Create;
1590    FSQL := Query;
1342 –  FNames := TStringList.Create;
1591    FSize := 0;
1592    FUniqueRelationName := '';
1593 +  FInputSQLDA := sqldaType = daInput;
1594   end;
1595  
1596   destructor TIBXSQLDA.Destroy;
1597   var
1598    i: Integer;
1599   begin
1351 –  FNames.Free;
1600    if FXSQLDA <> nil then
1601    begin
1602      for i := 0 to FSize - 1 do
# Line 1361 | Line 1609 | begin
1609      FXSQLDA := nil;
1610      FXSQLVARs := nil;
1611    end;
1612 <  inherited;
1612 >  inherited Destroy;
1613   end;
1614  
1615 < procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1615 >    procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1616 >    UniqueName: boolean);
1617   var
1618 <  fn: String;
1618 >  fn: string;
1619   begin
1620 <  fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1621 <  while FNames.Count <= Idx do
1622 <    FNames.Add('');
1623 <  FNames[Idx] := fn;
1624 <  FXSQLVARs[Idx].FName := fn;
1620 >  {$ifdef UseCaseSensitiveParamName}
1621 >  FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1622 >  {$else}
1623 >  FXSQLVARs[Idx].FName := FieldName;
1624 >  {$endif}
1625    FXSQLVARs[Idx].FIndex := Idx;
1626 +  FXSQLVARs[Idx].FUniqueName :=  UniqueName
1627   end;
1628  
1629   function TIBXSQLDA.GetModified: Boolean;
# Line 1389 | Line 1639 | begin
1639      end;
1640   end;
1641  
1392 – function TIBXSQLDA.GetNames: String;
1393 – begin
1394 –  result := FNames.Text;
1395 – end;
1396 –
1642   function TIBXSQLDA.GetRecordSize: Integer;
1643   begin
1644    result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
# Line 1421 | Line 1666 | end;
1666   function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1667   var
1668    s: String;
1669 <  i, Cnt: Integer;
1669 >  i: Integer;
1670   begin
1671 <  s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1672 <  i := 0;
1673 <  Cnt := FNames.Count;
1674 <  while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1675 <  if i = Cnt then
1676 <    result := nil
1677 <  else
1678 <    result := GetXSQLVAR(i);
1671 >  {$ifdef ALLOWDIALECT3PARAMNAMES}
1672 >  s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1673 >  {$else}
1674 >  {$ifdef UseCaseSensitiveParamName}
1675 >   s := AnsiUpperCase(Idx);
1676 >  {$else}
1677 >   s := Idx;
1678 >  {$endif}
1679 >  {$endif}
1680 >  for i := 0 to FCount - 1 do
1681 >    if Vars[i].FName = s then
1682 >    begin
1683 >         Result := FXSQLVARs[i];
1684 >         Exit;
1685 >    end;
1686 >  Result := nil;
1687   end;
1688  
1689   procedure TIBXSQLDA.Initialize;
1690 +
1691 +    function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1692 +    var
1693 +       k: integer;
1694 +    begin
1695 +         for k := 0 to limit do
1696 +             if FXSQLVARs[k].FName = idx then
1697 +             begin
1698 +                  Result := FXSQLVARs[k];
1699 +                  Exit;
1700 +             end;
1701 +         Result := nil;
1702 +    end;
1703 +
1704   var
1705    i, j, j_len: Integer;
1439 –  NamesWereEmpty: Boolean;
1706    st: String;
1707    bUnique: Boolean;
1708 +  sBaseName: string;
1709   begin
1710    bUnique := True;
1711 <  NamesWereEmpty := (FNames.Count = 0);
1712 <  if FXSQLDA <> nil then begin
1713 <    for i := 0 to FCount - 1 do begin
1714 <      with FXSQLVARs[i].Data^ do begin
1715 <        if bUnique and (String(relname) <> '') then
1711 >  if FXSQLDA <> nil then
1712 >  begin
1713 >    for i := 0 to FCount - 1 do
1714 >    begin
1715 >      with FXSQLVARs[i].Data^ do
1716 >      begin
1717 >
1718 >        {First get the unique relation name, if any}
1719 >
1720 >        if bUnique and (strpas(relname) <> '') then
1721          begin
1722            if FUniqueRelationName = '' then
1723 <            FUniqueRelationName := String(relname)
1724 <          else if String(relname) <> FUniqueRelationName then
1725 <          begin
1726 <            FUniqueRelationName := '';
1727 <            bUnique := False;
1728 <          end;
1723 >            FUniqueRelationName := strpas(relname)
1724 >          else
1725 >            if strpas(relname) <> FUniqueRelationName then
1726 >            begin
1727 >              FUniqueRelationName := '';
1728 >              bUnique := False;
1729 >            end;
1730          end;
1731 <        if NamesWereEmpty then begin
1732 <          st := String(aliasname);
1733 <          if st = '' then begin
1734 <            st := 'F_'; {do not localize}
1731 >
1732 >        {If an output SQLDA then copy the aliasnames to the FName list. Ensure
1733 >         that they are all upper case only and disambiguated.
1734 >        }
1735 >
1736 >        if not FInputSQLDA then
1737 >        begin
1738 >          st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1739 >          if st = '' then
1740 >          begin
1741 >            sBaseName := 'F_'; {do not localize}
1742              aliasname_length := 2;
1743              j := 1; j_len := 1;
1744 <            StrPCopy(aliasname, st + IntToStr(j));
1745 <          end else begin
1746 <            StrPCopy(aliasname, st);
1744 >            st := sBaseName + IntToStr(j);
1745 >          end
1746 >          else
1747 >          begin
1748              j := 0; j_len := 0;
1749 +            sBaseName := st;
1750            end;
1751 <          while GetXSQLVARByName(String(aliasname)) <> nil do begin
1752 <            Inc(j); j_len := Length(IntToStr(j));
1753 <            if j_len + aliasname_length > 31 then
1754 <              StrPCopy(aliasname,
1755 <                       Copy(st, 1, 31 - j_len) +
1756 <                       IntToStr(j))
1757 <            else
1758 <              StrPCopy(aliasname, st + IntToStr(j));
1751 >
1752 >          {Look for other columns with the same name and make unique}
1753 >
1754 >          while VarByName(st,i-1) <> nil do
1755 >          begin
1756 >               Inc(j);
1757 >               j_len := Length(IntToStr(j));
1758 >               if j_len + Length(sBaseName) > 31 then
1759 >                  st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1760 >               else
1761 >                  st := sBaseName + IntToStr(j);
1762            end;
1763 <          Inc(aliasname_length, j_len);
1764 <          AddName(String(aliasname), i);
1763 >
1764 >          FXSQLVARs[i].FName := st;
1765          end;
1766 +
1767 +        {Finally initialise the XSQLVAR}
1768 +
1769 +        FXSQLVARs[i].FIndex := i;
1770 +
1771          case sqltype and (not 1) of
1772            SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1773 <          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1773 >          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1774            SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1775              if (sqllen = 0) then
1776                { Make sure you get a valid pointer anyway
# Line 1510 | Line 1800 | var
1800    i, OldSize: Integer;
1801    p : PXSQLVAR;
1802   begin
1513 –  FNames.Clear;
1803    FCount := Value;
1804    if FCount = 0 then
1805      FUniqueRelationName := ''
# Line 1532 | Line 1821 | begin
1821            FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1822          FXSQLVARs[i].FXSQLVAR := p;
1823          p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1535 – //        FNames.Add('');
1824        end;
1825        FSize := FCount;
1826      end;
# Line 1548 | Line 1836 | end;
1836  
1837   destructor TIBOutputDelimitedFile.Destroy;
1838   begin
1839 + {$IFDEF UNIX}
1840 +  if FHandle <> -1 then
1841 +     fpclose(FHandle);
1842 + {$ELSE}
1843    if FHandle <> 0 then
1844    begin
1845      FlushFileBuffers(FHandle);
1846      CloseHandle(FHandle);
1847    end;
1848 + {$ENDIF}
1849    inherited Destroy;
1850   end;
1851  
1852   procedure TIBOutputDelimitedFile.ReadyFile;
1853   var
1854    i: Integer;
1855 +  {$IFDEF UNIX}
1856 +  BytesWritten: cint;
1857 +  {$ELSE}
1858    BytesWritten: DWORD;
1859 +  {$ENDIF}
1860    st: string;
1861   begin
1862    if FColDelimiter = '' then
1863      FColDelimiter := TAB;
1864    if FRowDelimiter = '' then
1865      FRowDelimiter := CRLF;
1866 +  {$IFDEF UNIX}
1867 +  FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1868 +  {$ELSE}
1869    FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1870                          FILE_ATTRIBUTE_NORMAL, 0);
1871    if FHandle = INVALID_HANDLE_VALUE then
1872      FHandle := 0;
1873 +  {$ENDIF}
1874    if FOutputTitles then
1875    begin
1876      for i := 0 to Columns.Count - 1 do
1877        if i = 0 then
1878 <        st := string(Columns[i].Data^.aliasname)
1878 >        st := strpas(Columns[i].Data^.aliasname)
1879        else
1880 <        st := st + FColDelimiter + string(Columns[i].Data^.aliasname);
1880 >        st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1881      st := st + FRowDelimiter;
1882 +    {$IFDEF UNIX}
1883 +    if FHandle <> -1 then
1884 +       BytesWritten := FpWrite(FHandle,st[1],Length(st));
1885 +    if BytesWritten = -1 then
1886 +       raise Exception.Create('File Write Error');
1887 +    {$ELSE}
1888      WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1889 +    {$ENDIF}
1890    end;
1891   end;
1892  
1893   function TIBOutputDelimitedFile.WriteColumns: Boolean;
1894   var
1895    i: Integer;
1896 +  {$IFDEF UNIX}
1897 +  BytesWritten: cint;
1898 +  {$ELSE}
1899    BytesWritten: DWORD;
1900 +  {$ENDIF}
1901    st: string;
1902   begin
1903    result := False;
1904 +  {$IFDEF UNIX}
1905 +  if FHandle <> -1 then
1906 +  {$ELSE}
1907    if FHandle <> 0 then
1908 +  {$ENDIF}
1909    begin
1910      st := '';
1911      for i := 0 to Columns.Count - 1 do
# Line 1599 | Line 1915 | begin
1915        st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1916      end;
1917      st := st + FRowDelimiter;
1918 +  {$IFDEF UNIX}
1919 +    BytesWritten := FpWrite(FHandle,st[1],Length(st));
1920 +  {$ELSE}
1921      WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1922 +  {$ENDIF}
1923      if BytesWritten = DWORD(Length(st)) then
1924        result := True;
1925    end
# Line 1712 | Line 2032 | end;
2032   { TIBOutputRawFile }
2033   destructor TIBOutputRawFile.Destroy;
2034   begin
2035 + {$IFDEF UNIX}
2036 +  if FHandle <> -1 then
2037 +     fpclose(FHandle);
2038 + {$ELSE}
2039    if FHandle <> 0 then
2040    begin
2041      FlushFileBuffers(FHandle);
2042      CloseHandle(FHandle);
2043    end;
2044 + {$ENDIF}
2045    inherited Destroy;
2046   end;
2047  
2048   procedure TIBOutputRawFile.ReadyFile;
2049   begin
2050 +  {$IFDEF UNIX}
2051 +  FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
2052 +  {$ELSE}
2053    FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
2054                          FILE_ATTRIBUTE_NORMAL, 0);
2055    if FHandle = INVALID_HANDLE_VALUE then
2056      FHandle := 0;
2057 +  {$ENDIF}
2058   end;
2059  
2060   function TIBOutputRawFile.WriteColumns: Boolean;
# Line 1738 | Line 2067 | begin
2067    begin
2068      for i := 0 to Columns.Count - 1 do
2069      begin
2070 +      {$IFDEF UNIX}
2071 +      BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
2072 +      {$ELSE}
2073        WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
2074                  BytesWritten, nil);
2075 +      {$ENDIF}
2076        if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
2077          exit;
2078      end;
# Line 1750 | Line 2083 | end;
2083   { TIBInputRawFile }
2084   destructor TIBInputRawFile.Destroy;
2085   begin
2086 + {$IFDEF UNIX}
2087 +  if FHandle <> -1 then
2088 +     fpclose(FHandle);
2089 + {$ELSE}
2090    if FHandle <> 0 then
2091      CloseHandle(FHandle);
2092 <  inherited;
2092 > {$ENDIF}
2093 >  inherited Destroy;
2094   end;
2095  
2096   function TIBInputRawFile.ReadParameters: Boolean;
# Line 1761 | Line 2099 | var
2099    BytesRead: DWord;
2100   begin
2101    result := False;
2102 + {$IFDEF UNIX}
2103 +  if FHandle <> -1 then
2104 + {$ELSE}
2105    if FHandle <> 0 then
2106 + {$ENDIF}
2107    begin
2108      for i := 0 to Params.Count - 1 do
2109      begin
2110 +      {$IFDEF UNIX}
2111 +      BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
2112 +      {$ELSE}
2113        ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
2114                 BytesRead, nil);
2115 +      {$ENDIF}
2116        if BytesRead <> DWORD(Params[i].Data^.sqllen) then
2117          exit;
2118      end;
# Line 1776 | Line 2122 | end;
2122  
2123   procedure TIBInputRawFile.ReadyFile;
2124   begin
2125 + {$IFDEF UNIX}
2126 +  if FHandle <> -1 then
2127 +     fpclose(FHandle);
2128 +  FHandle := FpOpen(Filename,O_RdOnly);
2129 +  if FHandle = -1 then
2130 +     raise Exception.CreateFmt('Unable to open file %s',[Filename]);
2131 + {$ELSE}
2132    if FHandle <> 0 then
2133      CloseHandle(FHandle);
2134    FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
2135                          FILE_FLAG_SEQUENTIAL_SCAN, 0);
2136    if FHandle = INVALID_HANDLE_VALUE then
2137      FHandle := 0;
2138 + {$ENDIF}
2139   end;
2140  
2141   { TIBSQL }
# Line 1804 | Line 2158 | begin
2158    TStringList(FSQL).OnChanging := SQLChanging;
2159    FProcessedSQL := TStringList.Create;
2160    FHandle := nil;
2161 <  FSQLParams := TIBXSQLDA.Create(self);
2162 <  FSQLRecord := TIBXSQLDA.Create(self);
2161 >  FSQLParams := TIBXSQLDA.Create(self,daInput);
2162 >  FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2163    FSQLType := SQLUnknown;
2164    FParamCheck := True;
2165    FCursor := Name + RandomString(8);
# Line 1830 | Line 2184 | begin
2184      FSQLParams.Free;
2185      FSQLRecord.Free;
2186    end;
2187 <  inherited;
2187 >  inherited Destroy;
2188   end;
2189  
2190   procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
# Line 1918 | Line 2272 | begin
2272    result := FSQLRecord;
2273   end;
2274  
2275 + function TIBSQL.GetFieldCount: integer;
2276 + begin
2277 +  Result := FSQLRecord.Count
2278 + end;
2279 +
2280 + procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
2281 + begin
2282 +  if FUniqueParamNames = AValue then Exit;
2283 +  FreeHandle;
2284 +  FUniqueParamNames := AValue;
2285 + end;
2286 +
2287   procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2288   begin
2289    if (FHandle <> nil) then begin
# Line 1957 | Line 2323 | begin
2323                              @FHandle,
2324                              Database.SQLDialect,
2325                              FSQLParams.AsXSQLDA,
2326 <                            FSQLRecord.AsXSQLDA), False);
2327 <      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2326 >                            FSQLRecord.AsXSQLDA), True);
2327 > (*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2328        begin
2329           { Sometimes a prepared stored procedure appears to get
2330             off sync on the server ....This code is meant to try
# Line 1973 | Line 2339 | begin
2339                              Database.SQLDialect,
2340                              FSQLParams.AsXSQLDA,
2341                              FSQLRecord.AsXSQLDA), True);
2342 <      end;
2342 >      end;  *)
2343      end
2344      else
2345        Call(isc_dsql_execute(StatusVector,
# Line 2001 | Line 2367 | begin
2367    result := GetFields(i);
2368   end;
2369  
2370 + function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2371 + begin
2372 +  Result := Params.ByName(ParamName);
2373 + end;
2374 +
2375   function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2376   begin
2377    if (Idx < 0) or (Idx >= FSQLRecord.Count) then
# Line 2108 | Line 2479 | begin
2479    result := FRecordCount;
2480   end;
2481  
2482 < function TIBSQL.GetRowsAffected: integer;
2482 > function TIBSQL.GetRowsAffected: Integer;
2483   var
2484    result_buffer: array[0..1048] of Char;
2485    info_request: Char;
# Line 2159 | Line 2530 | var
2530    cCurChar, cNextChar, cQuoteChar: Char;
2531    sSQL, sProcessedSQL, sParamName: String;
2532    i, iLenSQL, iSQLPos: Integer;
2533 <  iCurState, iCurParamState: Integer;
2533 >  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2534    iParamSuffix: Integer;
2535    slNames: TStrings;
2536  
# Line 2168 | Line 2539 | const
2539    CommentState = 1;
2540    QuoteState = 2;
2541    ParamState = 3;
2542 + {$ifdef ALLOWDIALECT3PARAMNAMES}
2543    ParamDefaultState = 0;
2544    ParamQuoteState = 1;
2545 +  {$endif}
2546  
2547    procedure AddToProcessedSQL(cChar: Char);
2548    begin
# Line 2189 | Line 2562 | begin
2562      i := 1;
2563      iSQLPos := 1;
2564      iCurState := DefaultState;
2565 +    {$ifdef ALLOWDIALECT3PARAMNAMES}
2566      iCurParamState := ParamDefaultState;
2567 +    {$endif}
2568      { Now, traverse through the SQL string, character by character,
2569       picking out the parameters and formatting correctly for InterBase }
2570      while (i <= iLenSQL) do begin
# Line 2240 | Line 2615 | begin
2615          ParamState:
2616          begin
2617            { collect the name of the parameter }
2618 +          {$ifdef ALLOWDIALECT3PARAMNAMES}
2619            if iCurParamState = ParamDefaultState then
2620            begin
2621              if cCurChar = '"' then
2622                iCurParamState := ParamQuoteState
2623 <            else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2623 >            else
2624 >            {$endif}
2625 >            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2626                  sParamName := sParamName + cCurChar
2627              else if FGenerateParamNames then
2628              begin
2629                sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2630                Inc(iParamSuffix);
2631                iCurState := DefaultState;
2632 <              slNames.Add(sParamName);
2632 >              slNames.AddObject(sParamName,self); //Note local convention
2633 >                                                  //add pointer to self to mark entry
2634                sParamName := '';
2635              end
2636              else
2637                IBError(ibxeSQLParseError, [SParamNameExpected]);
2638 +          {$ifdef ALLOWDIALECT3PARAMNAMES}
2639            end
2640            else begin
2641              { determine if Quoted parameter name is finished }
# Line 2270 | Line 2650 | begin
2650              else
2651                sParamName := sParamName + cCurChar
2652            end;
2653 +          {$endif}
2654            { determine if the unquoted parameter name is finished }
2655 <          if (iCurParamState <> ParamQuoteState) and
2655 >          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2656              (iCurState <> DefaultState) then
2657            begin
2658              if not (cNextChar in ['A'..'Z', 'a'..'z',
# Line 2291 | Line 2672 | begin
2672      AddToProcessedSQL(#0);
2673      FSQLParams.Count := slNames.Count;
2674      for i := 0 to slNames.Count - 1 do
2675 <      FSQLParams.AddName(slNames[i], i);
2675 >      FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2676      FProcessedSQL.Text := sProcessedSQL;
2677    finally
2678      slNames.Free;
# Line 2378 | Line 2759 | begin
2759      on E: Exception do begin
2760        if (FHandle <> nil) then
2761          FreeHandle;
2762 <      raise;
2762 >      if E is EIBInterBaseError then
2763 >        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2764 >                                       EIBInterBaseError(E).IBErrorCode,
2765 >                                       EIBInterBaseError(E).Message +
2766 >                                       sSQLErrorSeparator + FProcessedSQL.Text)
2767 >      else
2768 >        raise;
2769      end;
2770    end;
2771   end;

Diff Legend

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