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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC

# Line 1 | Line 1
1 < {************************************************************************}
2 < {                                                                        }
3 < {       Borland Delphi Visual Component Library                          }
4 < {       InterBase Express core components                                }
5 < {                                                                        }
6 < {       Copyright (c) 1998-2000 Inprise Corporation                      }
7 < {                                                                        }
8 < {    InterBase Express is based in part on the product                   }
9 < {    Free IB Components, written by Gregory H. Deatz for                 }
10 < {    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
11 < {    Free IB Components is used under license.                           }
12 < {                                                                        }
13 < {    The contents of this file are subject to the InterBase              }
14 < {    Public License Version 1.0 (the "License"); you may not             }
15 < {    use this file except in compliance with the License. You            }
16 < {    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 < {    Software distributed under the License is distributed on            }
18 < {    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19 < {    express or implied. See the License for the specific language       }
20 < {    governing rights and limitations under the License.                 }
21 < {    The Original Code was created by InterBase Software Corporation     }
22 < {       and its successors.                                              }
23 < {    Portions created by Inprise Corporation are Copyright (C) Inprise   }
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                                                 }
31 < {                                                                        }
32 < {************************************************************************}
33 <
34 < unit IBSQL;
35 <
36 < {$Mode Delphi}
37 <
38 < interface
39 <
40 < uses
41 < {$IFDEF WINDOWS }
42 <  Windows,
43 < {$ELSE}
44 <  baseunix, unix,
45 < {$ENDIF}
46 <  SysUtils, Classes, Forms, Controls, IBHeader,
47 <  IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
48 <
49 < type
50 <  TIBSQL = class;
51 <  TIBXSQLDA = class;
52 <  
53 <  { TIBXSQLVAR }
54 <  TIBXSQLVAR = class(TObject)
55 <  private
56 <    FParent: TIBXSQLDA;
57 <    FSQL: TIBSQL;
58 <    FIndex: Integer;
59 <    FModified: Boolean;
60 <    FName: String;
61 <    FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
62 <
63 <    function AdjustScale(Value: Int64; Scale: Integer): Double;
64 <    function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
65 <    function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
66 <    function GetAsCurrency: Currency;
67 <    function GetAsInt64: Int64;
68 <    function GetAsDateTime: TDateTime;
69 <    function GetAsDouble: Double;
70 <    function GetAsFloat: Float;
71 <    function GetAsLong: Long;
72 <    function GetAsPointer: Pointer;
73 <    function GetAsQuad: TISC_QUAD;
74 <    function GetAsShort: Short;
75 <    function GetAsString: String;
76 <    function GetAsVariant: Variant;
77 <    function GetAsXSQLVAR: PXSQLVAR;
78 <    function GetIsNull: Boolean;
79 <    function GetIsNullable: Boolean;
80 <    function GetSize: Integer;
81 <    function GetSQLType: Integer;
82 <    procedure SetAsCurrency(Value: Currency);
83 <    procedure SetAsInt64(Value: Int64);
84 <    procedure SetAsDate(Value: TDateTime);
85 <    procedure SetAsTime(Value: TDateTime);
86 <    procedure SetAsDateTime(Value: TDateTime);
87 <    procedure SetAsDouble(Value: Double);
88 <    procedure SetAsFloat(Value: Float);
89 <    procedure SetAsLong(Value: Long);
90 <    procedure SetAsPointer(Value: Pointer);
91 <    procedure SetAsQuad(Value: TISC_QUAD);
92 <    procedure SetAsShort(Value: Short);
93 <    procedure SetAsString(Value: String);
94 <    procedure SetAsVariant(Value: Variant);
95 <    procedure SetAsXSQLVAR(Value: PXSQLVAR);
96 <    procedure SetIsNull(Value: Boolean);
97 <    procedure SetIsNullable(Value: Boolean);
98 <  public
99 <    constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
100 <    procedure Assign(Source: TIBXSQLVAR);
101 <    procedure Clear;
102 <    procedure LoadFromFile(const FileName: String);
103 <    procedure LoadFromStream(Stream: TStream);
104 <    procedure SaveToFile(const FileName: String);
105 <    procedure SaveToStream(Stream: TStream);
106 <    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
107 <    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
108 <    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
109 <    property AsDouble: Double read GetAsDouble write SetAsDouble;
110 <    property AsFloat: Float read GetAsFloat write SetAsFloat;
111 <    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
112 <    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
113 <    property AsInteger: Integer read GetAsLong write SetAsLong;
114 <    property AsLong: Long read GetAsLong write SetAsLong;
115 <    property AsPointer: Pointer read GetAsPointer write SetAsPointer;
116 <    property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
117 <    property AsShort: Short read GetAsShort write SetAsShort;
118 <    property AsString: String read GetAsString write SetAsString;
119 <    property AsVariant: Variant read GetAsVariant write SetAsVariant;
120 <    property AsXSQLVAR: PXSQLVAR read GetAsXSQLVAR write SetAsXSQLVAR;
121 <    property Data: PXSQLVAR read FXSQLVAR write FXSQLVAR;
122 <    property IsNull: Boolean read GetIsNull write SetIsNull;
123 <    property IsNullable: Boolean read GetIsNullable write SetIsNullable;
124 <    property Index: Integer read FIndex;
125 <    property Modified: Boolean read FModified write FModified;
126 <    property Name: String read FName;
127 <    property Size: Integer read GetSize;
128 <    property SQLType: Integer read GetSQLType;
129 <    property Value: Variant read GetAsVariant write SetAsVariant;
130 <  end;
131 <
132 <  TIBXSQLVARArray = Array of TIBXSQLVAR;
133 <
134 <  { TIBXSQLVAR }
135 <  TIBXSQLDA = class(TObject)
136 <  protected
137 <    FSQL: TIBSQL;
138 <    FCount: Integer;
139 <    FNames: TStrings;
140 <    FSize: Integer;
141 <    FXSQLDA: PXSQLDA;
142 <    FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
143 <    FUniqueRelationName: String;
144 <    function GetModified: Boolean;
145 <    function GetNames: String;
146 <    function GetRecordSize: Integer;
147 <    function GetXSQLDA: PXSQLDA;
148 <    function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
149 <    function GetXSQLVARByName(Idx: String): TIBXSQLVAR;
150 <    procedure Initialize;
151 <    procedure SetCount(Value: Integer);
152 <  public
153 <    constructor Create(Query: TIBSQL);
154 <    destructor Destroy; override;
155 <    procedure AddName(FieldName: String; Idx: Integer);
156 <    function ByName(Idx: String): TIBXSQLVAR;
157 <    property AsXSQLDA: PXSQLDA read GetXSQLDA;
158 <    property Count: Integer read FCount write SetCount;
159 <    property Modified: Boolean read GetModified;
160 <    property Names: String read GetNames;
161 <    property RecordSize: Integer read GetRecordSize;
162 <    property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
163 <    property UniqueRelationName: String read FUniqueRelationName;
164 <  end;
165 <
166 <  { TIBBatch }
167 <
168 <  TIBBatch = class(TObject)
169 <  protected
170 <    FFilename: String;
171 <    FColumns: TIBXSQLDA;
172 <    FParams: TIBXSQLDA;
173 <  public
174 <    procedure ReadyFile; virtual; abstract;
175 <    property Columns: TIBXSQLDA read FColumns;
176 <    property Filename: String read FFilename write FFilename;
177 <    property Params: TIBXSQLDA read FParams;
178 <  end;
179 <
180 <  TIBBatchInput = class(TIBBatch)
181 <  public
182 <    function ReadParameters: Boolean; virtual; abstract;
183 <  end;
184 <
185 <  TIBBatchOutput = class(TIBBatch)
186 <  public
187 <    function WriteColumns: Boolean; virtual; abstract;
188 <  end;
189 <
190 <
191 <  { TIBOutputDelimitedFile }
192 <  TIBOutputDelimitedFile = class(TIBBatchOutput)
193 <  protected
194 <  {$IFDEF UNIX}
195 <    FHandle: cint;
196 <  {$ELSE}
197 <    FHandle: THandle;
198 <  {$ENDIF}
199 <    FOutputTitles: Boolean;
200 <    FColDelimiter,
201 <    FRowDelimiter: string;
202 <  public
203 <    destructor Destroy; override;
204 <    procedure ReadyFile; override;
205 <    function WriteColumns: Boolean; override;
206 <    property ColDelimiter: string read FColDelimiter write FColDelimiter;
207 <    property OutputTitles: Boolean read FOutputTitles
208 <                                   write FOutputTitles;
209 <    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
210 <  end;
211 <
212 <  { TIBInputDelimitedFile }
213 <  TIBInputDelimitedFile = class(TIBBatchInput)
214 <  protected
215 <    FColDelimiter,
216 <    FRowDelimiter: string;
217 <    FEOF: Boolean;
218 <    FFile: TFileStream;
219 <    FLookAhead: Char;
220 <    FReadBlanksAsNull: Boolean;
221 <    FSkipTitles: Boolean;
222 <  public
223 <    destructor Destroy; override;
224 <    function GetColumn(var Col: string): Integer;
225 <    function ReadParameters: Boolean; override;
226 <    procedure ReadyFile; override;
227 <    property ColDelimiter: string read FColDelimiter write FColDelimiter;
228 <    property ReadBlanksAsNull: Boolean read FReadBlanksAsNull
229 <                                       write FReadBlanksAsNull;
230 <    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
231 <    property SkipTitles: Boolean read FSkipTitles write FSkipTitles;
232 <  end;
233 <
234 <  { TIBOutputRawFile }
235 <  TIBOutputRawFile = class(TIBBatchOutput)
236 <  protected
237 <  {$IFDEF UNIX}
238 <    FHandle: cint;
239 <  {$ELSE}
240 <    FHandle: THandle;
241 <  {$ENDIF}
242 <  public
243 <    destructor Destroy; override;
244 <    procedure ReadyFile; override;
245 <    function WriteColumns: Boolean; override;
246 <  end;
247 <
248 <  { TIBInputRawFile }
249 <  TIBInputRawFile = class(TIBBatchInput)
250 <  protected
251 <   {$IFDEF UNIX}
252 <    FHandle: cint;
253 <  {$ELSE}
254 <    FHandle: THandle;
255 <  {$ENDIF}
256 <  public
257 <    destructor Destroy; override;
258 <    function ReadParameters: Boolean; override;
259 <    procedure ReadyFile; override;
260 <  end;
261 <
262 <     { TIBSQL }
263 <  TIBSQLTypes = (SQLUnknown, SQLSelect, SQLInsert,
264 <                  SQLUpdate, SQLDelete, SQLDDL,
265 <                  SQLGetSegment, SQLPutSegment,
266 <                  SQLExecProcedure, SQLStartTransaction,
267 <                  SQLCommit, SQLRollback,
268 <                  SQLSelectForUpdate, SQLSetGenerator);
269 <
270 <  TIBSQL = class(TComponent)
271 <  private
272 <    FIBLoaded: Boolean;
273 <    function GetFieldCount: integer;
274 <  protected
275 <    FBase: TIBBase;
276 <    FBOF,                          { At BOF? }
277 <    FEOF,                          { At EOF? }
278 <    FGoToFirstRecordOnExecute,     { Automatically position record on first record after executing }
279 <    FOpen,                         { Is a cursor open? }
280 <    FPrepared: Boolean;            { Has the query been prepared? }
281 <    FRecordCount: Integer;         { How many records have been read so far? }
282 <    FCursor: String;               { Cursor name...}
283 <    FHandle: TISC_STMT_HANDLE;     { Once prepared, this accesses the SQL Query }
284 <    FOnSQLChanging: TNotifyEvent;  { Call this when the SQL is changing }
285 <    FSQL: TStrings;                { SQL Query (by user) }
286 <    FParamCheck: Boolean;          { Check for parameters? (just like TQuery) }
287 <    FProcessedSQL: TStrings;       { SQL Query (pre-processed for param labels) }
288 <    FSQLParams,                    { Any parameters to the query }
289 <    FSQLRecord: TIBXSQLDA;         { The current record }
290 <    FSQLType: TIBSQLTypes;         { Select, update, delete, insert, create, alter, etc...}
291 <    FGenerateParamNames: Boolean;  { Auto generate param names ?}
292 <    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
293 <    function GetDatabase: TIBDatabase;
294 <    function GetDBHandle: PISC_DB_HANDLE;
295 <    function GetEOF: Boolean;
296 <    function GetFields(const Idx: Integer): TIBXSQLVAR;
297 <    function GetFieldIndex(FieldName: String): Integer;
298 <    function GetPlan: String;
299 <    function GetRecordCount: Integer;
300 <    function GetRowsAffected: Integer;
301 <    function GetSQLParams: TIBXSQLDA;
302 <    function GetTransaction: TIBTransaction;
303 <    function GetTRHandle: PISC_TR_HANDLE;
304 <    procedure PreprocessSQL;
305 <    procedure SetDatabase(Value: TIBDatabase);
306 <    procedure SetSQL(Value: TStrings);
307 <    procedure SetTransaction(Value: TIBTransaction);
308 <    procedure SQLChanging(Sender: TObject);
309 <    procedure BeforeTransactionEnd(Sender: TObject);
310 <  public
311 <    constructor Create(AOwner: TComponent); override;
312 <    destructor Destroy; override;
313 <    procedure BatchInput(InputObject: TIBBatchInput);
314 <    procedure BatchOutput(OutputObject: TIBBatchOutput);
315 <    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
316 <    procedure CheckClosed;           { raise error if query is not closed. }
317 <    procedure CheckOpen;             { raise error if query is not open.}
318 <    procedure CheckValidStatement;   { raise error if statement is invalid.}
319 <    procedure Close;
320 <    function Current: TIBXSQLDA;
321 <    procedure ExecQuery;
322 <    function FieldByName(FieldName: String): TIBXSQLVAR;
323 <    function ParamByName(ParamName: String): TIBXSQLVAR;
324 <    procedure FreeHandle;
325 <    function Next: TIBXSQLDA;
326 <    procedure Prepare;
327 <    function GetUniqueRelationName: String;
328 <    property Bof: Boolean read FBOF;
329 <    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
330 <    property Eof: Boolean read GetEOF;
331 <    property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
332 <    property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
333 <    property FieldCount: integer read GetFieldCount;
334 <    property Open: Boolean read FOpen;
335 <    property Params: TIBXSQLDA read GetSQLParams;
336 <    property Plan: String read GetPlan;
337 <    property Prepared: Boolean read FPrepared;
338 <    property RecordCount: Integer read GetRecordCount;
339 <    property RowsAffected: Integer read GetRowsAffected;
340 <    property SQLType: TIBSQLTypes read FSQLType;
341 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
342 <    property Handle: TISC_STMT_HANDLE read FHandle;
343 <    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
344 <    property UniqueRelationName: String read GetUniqueRelationName;
345 <  published
346 <    property Database: TIBDatabase read GetDatabase write SetDatabase;
347 <    property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
348 <                                               write FGoToFirstRecordOnExecute
349 <                                               default True;
350 <    property ParamCheck: Boolean read FParamCheck write FParamCheck;
351 <    property SQL: TStrings read FSQL write SetSQL;
352 <    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
353 <    property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
354 <  end;
355 <
356 < implementation
357 <
358 < uses
359 <  IBIntf, IBBlob, Variants , IBSQLMonitor;
360 <
361 < { TIBXSQLVAR }
362 < constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
363 < begin
364 <  inherited Create;
365 <  FParent := Parent;
366 <  FSQL := Query;
367 < end;
368 <
369 < procedure TIBXSQLVAR.Assign(Source: TIBXSQLVAR);
370 < var
371 <  szBuff: PChar;
372 <  s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
373 <  bSourceBlob, bDestBlob: Boolean;
374 <  iSegs: Int64;
375 <  iMaxSeg: Int64;
376 <  iSize: Int64;
377 <  iBlobType: Short;
378 < begin
379 <  szBuff := nil;
380 <  bSourceBlob := True;
381 <  bDestBlob := True;
382 <  s_bhandle := nil;
383 <  d_bhandle := nil;
384 <  try
385 <    if (Source.IsNull) then
386 <    begin
387 <      IsNull := True;
388 <      exit;
389 <    end
390 <    else
391 <      if (FXSQLVAR^.sqltype and (not 1) = SQL_ARRAY) or
392 <         (Source.FXSQLVAR^.sqltype and (not 1) = SQL_ARRAY) then
393 <        exit; { arrays not supported }
394 <    if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
395 <       (Source.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
396 <    begin
397 <      AsXSQLVAR := Source.AsXSQLVAR;
398 <      exit;
399 <    end
400 <    else
401 <      if (Source.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
402 <      begin
403 <        szBuff := nil;
404 <        IBAlloc(szBuff, 0, Source.FXSQLVAR^.sqllen);
405 <        Move(Source.FXSQLVAR^.sqldata[0], szBuff[0], Source.FXSQLVAR^.sqllen);
406 <        bSourceBlob := False;
407 <        iSize := Source.FXSQLVAR^.sqllen;
408 <      end
409 <      else
410 <        if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
411 <          bDestBlob := False;
412 <
413 <    if bSourceBlob then
414 <    begin
415 <      { read the blob }
416 <      Source.FSQL.Call(isc_open_blob2(StatusVector, Source.FSQL.DBHandle,
417 <        Source.FSQL.TRHandle, @s_bhandle, PISC_QUAD(Source.FXSQLVAR.sqldata),
418 <        0, nil), True);
419 <      try
420 <        IBBlob.GetBlobInfo(@s_bhandle, iSegs, iMaxSeg, iSize,
421 <          iBlobType);
422 <        szBuff := nil;
423 <        IBAlloc(szBuff, 0, iSize);
424 <        IBBlob.ReadBlob(@s_bhandle, szBuff, iSize);
425 <      finally
426 <        Source.FSQL.Call(isc_close_blob(StatusVector, @s_bhandle), True);
427 <      end;
428 <    end;
429 <
430 <    if bDestBlob then
431 <    begin
432 <      { write the blob }
433 <      FSQL.Call(isc_create_blob2(StatusVector, FSQL.DBHandle,
434 <        FSQL.TRHandle, @d_bhandle, PISC_QUAD(FXSQLVAR.sqldata),
435 <        0, nil), True);
436 <      try
437 <        IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
438 <        isNull := false
439 <      finally
440 <        FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
441 <      end;
442 <    end
443 <    else
444 <    begin
445 <      { just copy the buffer }
446 <      FXSQLVAR.sqltype := SQL_TEXT;
447 <      FXSQLVAR.sqllen := iSize;
448 <      IBAlloc(FXSQLVAR.sqldata, iSize, iSize);
449 <      Move(szBuff[0], FXSQLVAR^.sqldata[0], iSize);
450 <    end;
451 <  finally
452 <    FreeMem(szBuff);
453 <  end;
454 < end;
455 <
456 < function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
457 < var
458 <  Scaling : Int64;
459 <  i: Integer;
460 <  Val: Double;
461 < begin
462 <  Scaling := 1; Val := Value;
463 <  if Scale > 0 then
464 <  begin
465 <    for i := 1 to Scale do
466 <      Scaling := Scaling * 10;
467 <    result := Val * Scaling;
468 <  end
469 <  else
470 <    if Scale < 0 then
471 <    begin
472 <      for i := -1 downto Scale do
473 <        Scaling := Scaling * 10;
474 <      result := Val / Scaling;
475 <    end
476 <    else
477 <      result := Val;
478 < end;
479 <
480 < function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
481 < var
482 <  Scaling : Int64;
483 <  i: Integer;
484 <  Val: Int64;
485 < begin
486 <  Scaling := 1; Val := Value;
487 <  if Scale > 0 then begin
488 <    for i := 1 to Scale do Scaling := Scaling * 10;
489 <    result := Val * Scaling;
490 <  end else if Scale < 0 then begin
491 <    for i := -1 downto Scale do Scaling := Scaling * 10;
492 <    result := Val div Scaling;
493 <  end else
494 <    result := Val;
495 < end;
496 <
497 < function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
498 < var
499 <  Scaling : Int64;
500 <  i : Integer;
501 <  FractionText, PadText, CurrText: string;
502 < begin
503 <  Result := 0;
504 <  Scaling := 1;
505 <  if Scale > 0 then
506 <  begin
507 <    for i := 1 to Scale do
508 <      Scaling := Scaling * 10;
509 <    result := Value * Scaling;
510 <  end
511 <  else
512 <    if Scale < 0 then
513 <    begin
514 <      for i := -1 downto Scale do
515 <        Scaling := Scaling * 10;
516 <      FractionText := IntToStr(abs(Value mod Scaling));
517 <      for i := Length(FractionText) to -Scale -1 do
518 <        PadText := '0' + PadText;
519 <      if Value < 0 then
520 <        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
521 <      else
522 <        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
523 <      try
524 <        result := StrToCurr(CurrText);
525 <      except
526 <        on E: Exception do
527 <          IBError(ibxeInvalidDataConversion, [nil]);
528 <      end;
529 <    end
530 <    else
531 <      result := Value;
532 < end;
533 <
534 < function TIBXSQLVAR.GetAsCurrency: Currency;
535 < begin
536 <  result := 0;
537 <  if FSQL.Database.SQLDialect < 3 then
538 <    result := GetAsDouble
539 <  else begin
540 <    if not IsNull then
541 <      case FXSQLVAR^.sqltype and (not 1) of
542 <        SQL_TEXT, SQL_VARYING: begin
543 <          try
544 <            result := StrtoCurr(AsString);
545 <          except
546 <            on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
547 <          end;
548 <        end;
549 <        SQL_SHORT:
550 <          result := AdjustScaleToCurrency(Int64(PShort(FXSQLVAR^.sqldata)^),
551 <                                      FXSQLVAR^.sqlscale);
552 <        SQL_LONG:
553 <          result := AdjustScaleToCurrency(Int64(PLong(FXSQLVAR^.sqldata)^),
554 <                                      FXSQLVAR^.sqlscale);
555 <        SQL_INT64:
556 <          result := AdjustScaleToCurrency(PInt64(FXSQLVAR^.sqldata)^,
557 <                                      FXSQLVAR^.sqlscale);
558 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
559 <          result := Trunc(AsDouble);
560 <        else
561 <          IBError(ibxeInvalidDataConversion, [nil]);
562 <      end;
563 <    end;
564 < end;
565 <
566 < function TIBXSQLVAR.GetAsInt64: Int64;
567 < begin
568 <  result := 0;
569 <  if not IsNull then
570 <    case FXSQLVAR^.sqltype and (not 1) of
571 <      SQL_TEXT, SQL_VARYING: begin
572 <        try
573 <          result := StrToInt64(AsString);
574 <        except
575 <          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
576 <        end;
577 <      end;
578 <      SQL_SHORT:
579 <        result := AdjustScaleToInt64(Int64(PShort(FXSQLVAR^.sqldata)^),
580 <                                    FXSQLVAR^.sqlscale);
581 <      SQL_LONG:
582 <        result := AdjustScaleToInt64(Int64(PLong(FXSQLVAR^.sqldata)^),
583 <                                    FXSQLVAR^.sqlscale);
584 <      SQL_INT64:
585 <        result := AdjustScaleToInt64(PInt64(FXSQLVAR^.sqldata)^,
586 <                                    FXSQLVAR^.sqlscale);
587 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
588 <        result := Trunc(AsDouble);
589 <      else
590 <        IBError(ibxeInvalidDataConversion, [nil]);
591 <    end;
592 < end;
593 <
594 < function TIBXSQLVAR.GetAsDateTime: TDateTime;
595 < var
596 <  tm_date: TCTimeStructure;
597 <  msecs: word;
598 < begin
599 <  result := 0;
600 <  if not IsNull then
601 <    case FXSQLVAR^.sqltype and (not 1) of
602 <      SQL_TEXT, SQL_VARYING: begin
603 <        try
604 <          result := StrToDate(AsString);
605 <        except
606 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
607 <        end;
608 <      end;
609 <      SQL_TYPE_DATE: begin
610 <        isc_decode_sql_date(PISC_DATE(FXSQLVAR^.sqldata), @tm_date);
611 <        try
612 <          result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
613 <                               Word(tm_date.tm_mday));
614 <        except
615 <          on E: EConvertError do begin
616 <            IBError(ibxeInvalidDataConversion, [nil]);
617 <          end;
618 <        end;
619 <      end;
620 <      SQL_TYPE_TIME: begin
621 <        isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
622 <        try
623 <          msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
624 <          result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
625 <                               Word(tm_date.tm_sec), msecs)
626 <        except
627 <          on E: EConvertError do begin
628 <            IBError(ibxeInvalidDataConversion, [nil]);
629 <          end;
630 <        end;
631 <      end;
632 <      SQL_TIMESTAMP: begin
633 <        isc_decode_date(PISC_QUAD(FXSQLVAR^.sqldata), @tm_date);
634 <        try
635 <          result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
636 <                              Word(tm_date.tm_mday));
637 <          msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
638 <          if result >= 0 then
639 <            result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
640 <                                          Word(tm_date.tm_sec), msecs)
641 <          else
642 <            result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
643 <                                          Word(tm_date.tm_sec), msecs)
644 <        except
645 <          on E: EConvertError do begin
646 <            IBError(ibxeInvalidDataConversion, [nil]);
647 <          end;
648 <        end;
649 <      end;
650 <      else
651 <        IBError(ibxeInvalidDataConversion, [nil]);
652 <    end;
653 < end;
654 <
655 < function TIBXSQLVAR.GetAsDouble: Double;
656 < begin
657 <  result := 0;
658 <  if not IsNull then begin
659 <    case FXSQLVAR^.sqltype and (not 1) of
660 <      SQL_TEXT, SQL_VARYING: begin
661 <        try
662 <          result := StrToFloat(AsString);
663 <        except
664 <          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
665 <        end;
666 <      end;
667 <      SQL_SHORT:
668 <        result := AdjustScale(Int64(PShort(FXSQLVAR^.sqldata)^),
669 <                              FXSQLVAR^.sqlscale);
670 <      SQL_LONG:
671 <        result := AdjustScale(Int64(PLong(FXSQLVAR^.sqldata)^),
672 <                              FXSQLVAR^.sqlscale);
673 <      SQL_INT64:
674 <        result := AdjustScale(PInt64(FXSQLVAR^.sqldata)^, FXSQLVAR^.sqlscale);
675 <      SQL_FLOAT:
676 <        result := PFloat(FXSQLVAR^.sqldata)^;
677 <      SQL_DOUBLE, SQL_D_FLOAT:
678 <        result := PDouble(FXSQLVAR^.sqldata)^;
679 <      else
680 <        IBError(ibxeInvalidDataConversion, [nil]);
681 <    end;
682 <    if  FXSQLVAR^.sqlscale <> 0 then
683 <      result :=
684 <        StrToFloat(FloatToStrF(result, fffixed, 15,
685 <                  Abs(FXSQLVAR^.sqlscale) ));
686 <  end;
687 < end;
688 <
689 < function TIBXSQLVAR.GetAsFloat: Float;
690 < begin
691 <  result := 0;
692 <  try
693 <    result := AsDouble;
694 <  except
695 <    on E: EOverflow do
696 <      IBError(ibxeInvalidDataConversion, [nil]);
697 <  end;
698 < end;
699 <
700 < function TIBXSQLVAR.GetAsLong: Long;
701 < begin
702 <  result := 0;
703 <  if not IsNull then
704 <    case FXSQLVAR^.sqltype and (not 1) of
705 <      SQL_TEXT, SQL_VARYING: begin
706 <        try
707 <          result := StrToInt(AsString);
708 <        except
709 <          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
710 <        end;
711 <      end;
712 <      SQL_SHORT:
713 <        result := Trunc(AdjustScale(Int64(PShort(FXSQLVAR^.sqldata)^),
714 <                                    FXSQLVAR^.sqlscale));
715 <      SQL_LONG:
716 <        result := Trunc(AdjustScale(Int64(PLong(FXSQLVAR^.sqldata)^),
717 <                                    FXSQLVAR^.sqlscale));
718 <      SQL_INT64:
719 <        result := Trunc(AdjustScale(PInt64(FXSQLVAR^.sqldata)^, FXSQLVAR^.sqlscale));
720 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
721 <        result := Trunc(AsDouble);
722 <      else
723 <        IBError(ibxeInvalidDataConversion, [nil]);
724 <    end;
725 < end;
726 <
727 < function TIBXSQLVAR.GetAsPointer: Pointer;
728 < begin
729 <  if not IsNull then
730 <    result := FXSQLVAR^.sqldata
731 <  else
732 <    result := nil;
733 < end;
734 <
735 < function TIBXSQLVAR.GetAsQuad: TISC_QUAD;
736 < begin
737 <  result.gds_quad_high := 0;
738 <  result.gds_quad_low := 0;
739 <  if not IsNull then
740 <    case FXSQLVAR^.sqltype and (not 1) of
741 <      SQL_BLOB, SQL_ARRAY, SQL_QUAD:
742 <        result := PISC_QUAD(FXSQLVAR^.sqldata)^;
743 <      else
744 <        IBError(ibxeInvalidDataConversion, [nil]);
745 <    end;
746 < end;
747 <
748 < function TIBXSQLVAR.GetAsShort: Short;
749 < begin
750 <  result := 0;
751 <  try
752 <    result := AsLong;
753 <  except
754 <    on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
755 <  end;
756 < end;
757 <
758 <
759 < function TIBXSQLVAR.GetAsString: String;
760 < var
761 <  sz: PChar;
762 <  str_len: Integer;
763 <  ss: TStringStream;
764 < begin
765 <  result := '';
766 <  { Check null, if so return a default string }
767 <  if not IsNull then
768 <    case FXSQLVar^.sqltype and (not 1) of
769 <      SQL_ARRAY:
770 <        result := '(Array)'; {do not localize}
771 <      SQL_BLOB: begin
772 <        ss := TStringStream.Create('');
773 <        try
774 <          SaveToStream(ss);
775 <          result := ss.DataString;
776 <        finally
777 <          ss.Free;
778 <        end;
779 <      end;
780 <      SQL_TEXT, SQL_VARYING: begin
781 <        sz := FXSQLVAR^.sqldata;
782 <        if (FXSQLVar^.sqltype and (not 1) = SQL_TEXT) then
783 <          str_len := FXSQLVar^.sqllen
784 <        else begin
785 <          str_len := isc_vax_integer(FXSQLVar^.sqldata, 2);
786 <          Inc(sz, 2);
787 <        end;
788 <        SetString(result, sz, str_len);
789 <        if ((FXSQLVar^.sqltype and (not 1)) = SQL_TEXT) then
790 <          result := TrimRight(result);
791 <      end;
792 <      SQL_TYPE_DATE:
793 <        case FSQL.Database.SQLDialect of
794 <          1 : result := DateTimeToStr(AsDateTime);
795 <          3 : result := DateToStr(AsDateTime);
796 <        end;
797 <      SQL_TYPE_TIME :
798 <        result := TimeToStr(AsDateTime);
799 <      SQL_TIMESTAMP:
800 <        result := DateTimeToStr(AsDateTime);
801 <      SQL_SHORT, SQL_LONG:
802 <        if FXSQLVAR^.sqlscale = 0 then
803 <          result := IntToStr(AsLong)
804 <        else if FXSQLVAR^.sqlscale >= (-4) then
805 <          result := CurrToStr(AsCurrency)
806 <        else
807 <          result := FloatToStr(AsDouble);
808 <      SQL_INT64:
809 <        if FXSQLVAR^.sqlscale = 0 then
810 <          result := IntToStr(AsInt64)
811 <        else if FXSQLVAR^.sqlscale >= (-4) then
812 <          result := CurrToStr(AsCurrency)
813 <        else
814 <          result := FloatToStr(AsDouble);
815 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
816 <        result := FloatToStr(AsDouble);
817 <      else
818 <        IBError(ibxeInvalidDataConversion, [nil]);
819 <    end;
820 < end;
821 <
822 < function TIBXSQLVAR.GetAsVariant: Variant;
823 < begin
824 <  if IsNull then
825 <    result := NULL
826 <  { Check null, if so return a default string }
827 <  else case FXSQLVar^.sqltype and (not 1) of
828 <      SQL_ARRAY:
829 <        result := '(Array)'; {do not localize}
830 <      SQL_BLOB:
831 <        result := '(Blob)'; {do not localize}
832 <      SQL_TEXT, SQL_VARYING:
833 <        result := AsString;
834 <      SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
835 <        result := AsDateTime;
836 <      SQL_SHORT, SQL_LONG:
837 <        if FXSQLVAR^.sqlscale = 0 then
838 <          result := AsLong
839 <        else if FXSQLVAR^.sqlscale >= (-4) then
840 <          result := AsCurrency
841 <        else
842 <          result := AsDouble;
843 <      SQL_INT64:
844 <        if FXSQLVAR^.sqlscale = 0 then
845 <          IBError(ibxeInvalidDataConversion, [nil])
846 <        else if FXSQLVAR^.sqlscale >= (-4) then
847 <          result := AsCurrency
848 <        else
849 <          result := AsDouble;
850 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
851 <        result := AsDouble;
852 <      else
853 <        IBError(ibxeInvalidDataConversion, [nil]);
854 <    end;
855 < end;
856 <
857 < function TIBXSQLVAR.GetAsXSQLVAR: PXSQLVAR;
858 < begin
859 <  result := FXSQLVAR;
860 < end;
861 <
862 < function TIBXSQLVAR.GetIsNull: Boolean;
863 < begin
864 <  result := IsNullable and (FXSQLVAR^.sqlind^ = -1);
865 < end;
866 <
867 < function TIBXSQLVAR.GetIsNullable: Boolean;
868 < begin
869 <  result := (FXSQLVAR^.sqltype and 1 = 1);
870 < end;
871 <
872 < procedure TIBXSQLVAR.LoadFromFile(const FileName: String);
873 < var
874 <  fs: TFileStream;
875 < begin
876 <  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
877 <  try
878 <    LoadFromStream(fs);
879 <  finally
880 <    fs.Free;
881 <  end;
882 < end;
883 <
884 < procedure TIBXSQLVAR.LoadFromStream(Stream: TStream);
885 < var
886 <  bs: TIBBlobStream;
887 < begin
888 <  bs := TIBBlobStream.Create;
889 <  try
890 <    bs.Mode := bmWrite;
891 <    bs.Database := FSQL.Database;
892 <    bs.Transaction := FSQL.Transaction;
893 <    Stream.Seek(0, soFromBeginning);
894 <    bs.LoadFromStream(Stream);
895 <    bs.Finalize;
896 <    AsQuad := bs.BlobID;
897 <  finally
898 <    bs.Free;
899 <  end;
900 < end;
901 <
902 < procedure TIBXSQLVAR.SaveToFile(const FileName: String);
903 < var
904 <  fs: TFileStream;
905 < begin
906 <  fs := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
907 <  try
908 <    SaveToStream(fs);
909 <  finally
910 <    fs.Free;
911 <  end;
912 < end;
913 <
914 < procedure TIBXSQLVAR.SaveToStream(Stream: TStream);
915 < var
916 <  bs: TIBBlobStream;
917 < begin
918 <  bs := TIBBlobStream.Create;
919 <  try
920 <    bs.Mode := bmRead;
921 <    bs.Database := FSQL.Database;
922 <    bs.Transaction := FSQL.Transaction;
923 <    bs.BlobID := AsQuad;
924 <    bs.SaveToStream(Stream);
925 <  finally
926 <    bs.Free;
927 <  end;
928 < end;
929 <
930 < function TIBXSQLVAR.GetSize: Integer;
931 < begin
932 <  result := FXSQLVAR^.sqllen;
933 < end;
934 <
935 < function TIBXSQLVAR.GetSQLType: Integer;
936 < begin
937 <  result := FXSQLVAR^.sqltype and (not 1);
938 < end;
939 <
940 < procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
941 < var
942 <  xvar: TIBXSQLVAR;
943 <  i: Integer;
944 < begin
945 <  if FSQL.Database.SQLDialect < 3 then
946 <    AsDouble := Value
947 <  else
948 <  begin
949 <    if IsNullable then
950 <      IsNull := False;
951 <    for i := 0 to FParent.FCount - 1 do
952 <      if FParent.FNames[i] = FName then
953 <      begin
954 <        xvar := FParent[i];
955 <        xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
956 <        xvar.FXSQLVAR^.sqlscale := -4;
957 <        xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
958 <        IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
959 <        PCurrency(xvar.FXSQLVAR^.sqldata)^ := Value;
960 <        xvar.FModified := True;
961 <      end;
962 <  end;
963 < end;
964 <
965 < procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
966 < var
967 <  i: Integer;
968 <  xvar: TIBXSQLVAR;
969 < begin
970 <  if IsNullable then
971 <    IsNull := False;
972 <  for i := 0 to FParent.FCount - 1 do
973 <    if FParent.FNames[i] = FName then
974 <    begin
975 <      xvar := FParent[i];
976 <      xvar.FXSQLVAR^.sqltype := SQL_INT64 or (xvar.FXSQLVAR^.sqltype and 1);
977 <      xvar.FXSQLVAR^.sqlscale := 0;
978 <      xvar.FXSQLVAR^.sqllen := SizeOf(Int64);
979 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
980 <      PInt64(xvar.FXSQLVAR^.sqldata)^ := Value;
981 <      xvar.FModified := True;
982 <    end;
983 < end;
984 <
985 < procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
986 < var
987 <  i: Integer;
988 <  tm_date: TCTimeStructure;
989 <  Yr, Mn, Dy: Word;
990 <  xvar: TIBXSQLVAR;
991 < begin
992 <  if FSQL.Database.SQLDialect < 3 then
993 <  begin
994 <    AsDateTime := Value;
995 <    exit;
996 <  end;
997 <  if IsNullable then
998 <    IsNull := False;
999 <  for i := 0 to FParent.FCount - 1 do
1000 <    if FParent.FNames[i] = FName then
1001 <    begin
1002 <      xvar := FParent[i];
1003 <      xvar.FXSQLVAR^.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR^.sqltype and 1);
1004 <      DecodeDate(Value, Yr, Mn, Dy);
1005 <      with tm_date do begin
1006 <        tm_sec := 0;
1007 <        tm_min := 0;
1008 <        tm_hour := 0;
1009 <        tm_mday := Dy;
1010 <        tm_mon := Mn - 1;
1011 <        tm_year := Yr - 1900;
1012 <      end;
1013 <      xvar.FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1014 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1015 <      isc_encode_sql_date(@tm_date, PISC_DATE(xvar.FXSQLVAR^.sqldata));
1016 <      xvar.FModified := True;
1017 <    end;
1018 < end;
1019 <
1020 < procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1021 < var
1022 <  i: Integer;
1023 <  tm_date: TCTimeStructure;
1024 <  Hr, Mt, S, Ms: Word;
1025 <  xvar: TIBXSQLVAR;
1026 < begin
1027 <  if FSQL.Database.SQLDialect < 3 then
1028 <  begin
1029 <    AsDateTime := Value;
1030 <    exit;
1031 <  end;
1032 <  if IsNullable then
1033 <    IsNull := False;
1034 <  for i := 0 to FParent.FCount - 1 do
1035 <    if FParent.FNames[i] = FName then
1036 <    begin
1037 <      xvar := FParent[i];
1038 <      xvar.FXSQLVAR^.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR^.sqltype and 1);
1039 <      DecodeTime(Value, Hr, Mt, S, Ms);
1040 <      with tm_date do begin
1041 <        tm_sec := S;
1042 <        tm_min := Mt;
1043 <        tm_hour := Hr;
1044 <        tm_mday := 0;
1045 <        tm_mon := 0;
1046 <        tm_year := 0;
1047 <      end;
1048 <      xvar.FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1049 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1050 <      isc_encode_sql_time(@tm_date, PISC_TIME(xvar.FXSQLVAR^.sqldata));
1051 <      if Ms > 0 then
1052 <        Inc(PISC_TIME(xvar.FXSQLVAR^.sqldata)^,Ms*10);
1053 <      xvar.FModified := True;
1054 <    end;
1055 < end;
1056 <
1057 < procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1058 < var
1059 <  i: Integer;
1060 <  tm_date: TCTimeStructure;
1061 <  Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1062 <  xvar: TIBXSQLVAR;
1063 < begin
1064 <  if IsNullable then
1065 <    IsNull := False;
1066 <  for i := 0 to FParent.FCount - 1 do
1067 <    if FParent.FNames[i] = FName then
1068 <    begin
1069 <      xvar := FParent[i];
1070 <      xvar.FXSQLVAR^.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR^.sqltype and 1);
1071 <      DecodeDate(Value, Yr, Mn, Dy);
1072 <      DecodeTime(Value, Hr, Mt, S, Ms);
1073 <      with tm_date do begin
1074 <        tm_sec := S;
1075 <        tm_min := Mt;
1076 <        tm_hour := Hr;
1077 <        tm_mday := Dy;
1078 <        tm_mon := Mn - 1;
1079 <        tm_year := Yr - 1900;
1080 <      end;
1081 <      xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1082 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1083 <      isc_encode_date(@tm_date, PISC_QUAD(xvar.FXSQLVAR^.sqldata));
1084 <      if Ms > 0 then
1085 <        Inc(PISC_TIMESTAMP(xvar.FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1086 <      xvar.FModified := True;
1087 <    end;
1088 < end;
1089 <
1090 < procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1091 < var
1092 <  i: Integer;
1093 <  xvar: TIBXSQLVAR;
1094 < begin
1095 <  if IsNullable then
1096 <    IsNull := False;
1097 <  for i := 0 to FParent.FCount - 1 do
1098 <    if FParent.FNames[i] = FName then
1099 <    begin
1100 <      xvar := FParent[i];
1101 <      xvar.FXSQLVAR^.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR^.sqltype and 1);
1102 <      xvar.FXSQLVAR^.sqllen := SizeOf(Double);
1103 <      xvar.FXSQLVAR^.sqlscale := 0;
1104 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1105 <      PDouble(xvar.FXSQLVAR^.sqldata)^ := Value;
1106 <      xvar.FModified := True;
1107 <    end;
1108 < end;
1109 <
1110 < procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1111 < var
1112 <  i: Integer;
1113 <  xvar: TIBXSQLVAR;
1114 < begin
1115 <  if IsNullable then
1116 <    IsNull := False;
1117 <  for i := 0 to FParent.FCount - 1 do
1118 <    if FParent.FNames[i] = FName then
1119 <    begin
1120 <      xvar := FParent[i];
1121 <      xvar.FXSQLVAR^.sqltype := SQL_FLOAT or (xvar.FXSQLVAR^.sqltype and 1);
1122 <      xvar.FXSQLVAR^.sqllen := SizeOf(Float);
1123 <      xvar.FXSQLVAR^.sqlscale := 0;
1124 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1125 <      PSingle(xvar.FXSQLVAR^.sqldata)^ := Value;
1126 <      xvar.FModified := True;
1127 <    end;
1128 < end;
1129 <
1130 < procedure TIBXSQLVAR.SetAsLong(Value: Long);
1131 < var
1132 <  i: Integer;
1133 <  xvar: TIBXSQLVAR;
1134 < begin
1135 <  if IsNullable then
1136 <    IsNull := False;
1137 <  for i := 0 to FParent.FCount - 1 do
1138 <    if FParent.FNames[i] = FName then
1139 <    begin
1140 <      xvar := FParent[i];
1141 <      xvar.FXSQLVAR^.sqltype := SQL_LONG or (xvar.FXSQLVAR^.sqltype and 1);
1142 <      xvar.FXSQLVAR^.sqllen := SizeOf(Long);
1143 <      xvar.FXSQLVAR^.sqlscale := 0;
1144 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1145 <      PLong(xvar.FXSQLVAR^.sqldata)^ := Value;
1146 <      xvar.FModified := True;
1147 <    end;
1148 < end;
1149 <
1150 < procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1151 < var
1152 <  i: Integer;
1153 <  xvar: TIBXSQLVAR;
1154 < begin
1155 <  if IsNullable and (Value = nil) then
1156 <    IsNull := True
1157 <  else begin
1158 <    IsNull := False;
1159 <    for i := 0 to FParent.FCount - 1 do
1160 <      if FParent.FNames[i] = FName then
1161 <      begin
1162 <        xvar := FParent[i];
1163 <        xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1164 <        Move(Value^, xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1165 <        xvar.FModified := True;
1166 <      end;
1167 <  end;
1168 < end;
1169 <
1170 < procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1171 < var
1172 <  i: Integer;
1173 <  xvar: TIBXSQLVAR;
1174 < begin
1175 <  if IsNullable then
1176 <    IsNull := False;
1177 <  for i := 0 to FParent.FCount - 1 do
1178 <    if FParent.FNames[i] = FName then
1179 <    begin
1180 <      xvar := FParent[i];
1181 <      if (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1182 <         (xvar.FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1183 <        IBError(ibxeInvalidDataConversion, [nil]);
1184 <      xvar.FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1185 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1186 <      PISC_QUAD(xvar.FXSQLVAR^.sqldata)^ := Value;
1187 <      xvar.FModified := True;
1188 <    end;
1189 < end;
1190 <
1191 < procedure TIBXSQLVAR.SetAsShort(Value: Short);
1192 < var
1193 <  i: Integer;
1194 <  xvar: TIBXSQLVAR;
1195 < begin
1196 <  if IsNullable then
1197 <    IsNull := False;
1198 <  for i := 0 to FParent.FCount - 1 do
1199 <    if FParent.FNames[i] = FName then
1200 <    begin
1201 <      xvar := FParent[i];
1202 <      xvar.FXSQLVAR^.sqltype := SQL_SHORT or (xvar.FXSQLVAR^.sqltype and 1);
1203 <      xvar.FXSQLVAR^.sqllen := SizeOf(Short);
1204 <      xvar.FXSQLVAR^.sqlscale := 0;
1205 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen);
1206 <      PShort(xvar.FXSQLVAR^.sqldata)^ := Value;
1207 <      xvar.FModified := True;
1208 <    end;
1209 < end;
1210 <
1211 < procedure TIBXSQLVAR.SetAsString(Value: String);
1212 < var
1213 <  stype: Integer;
1214 <  ss: TStringStream;
1215 <
1216 <  procedure SetStringValue;
1217 <  var
1218 <    i: Integer;
1219 <    xvar: TIBXSQLVAR;
1220 <  begin
1221 <    for i := 0 to FParent.FCount - 1 do
1222 <      if FParent.FNames[i] = FName then
1223 <      begin
1224 <        xvar := FParent[i];
1225 <        if (xvar.FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1226 <           (xvar.FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1227 <          Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen)
1228 <        else begin
1229 <          xvar.FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1230 <          xvar.FXSQLVAR^.sqllen := Length(Value);
1231 <          IBAlloc(xvar.FXSQLVAR^.sqldata, 0, xvar.FXSQLVAR^.sqllen + 1);
1232 <          if (Length(Value) > 0) then
1233 <            Move(Value[1], xvar.FXSQLVAR^.sqldata^, xvar.FXSQLVAR^.sqllen);
1234 <        end;
1235 <        xvar.FModified := True;
1236 <      end;
1237 <  end;
1238 <
1239 < begin
1240 <  if IsNullable then
1241 <    IsNull := False;
1242 <  stype := FXSQLVAR^.sqltype and (not 1);
1243 <  if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1244 <    SetStringValue
1245 <  else begin
1246 <    if (stype = SQL_BLOB) then
1247 <    begin
1248 <      ss := TStringStream.Create(Value);
1249 <      try
1250 <        LoadFromStream(ss);
1251 <      finally
1252 <        ss.Free;
1253 <      end;
1254 <    end
1255 <    else if Value = '' then
1256 <      IsNull := True
1257 <    else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1258 <      (stype = SQL_TYPE_TIME) then
1259 <      SetAsDateTime(StrToDateTime(Value))
1260 <    else
1261 <      SetStringValue;
1262 <  end;
1263 < end;
1264 <
1265 < procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1266 < begin
1267 <  if VarIsNull(Value) then
1268 <    IsNull := True
1269 <  else case VarType(Value) of
1270 <    varEmpty, varNull:
1271 <      IsNull := True;
1272 <    varSmallint, varInteger, varByte:
1273 <      AsLong := Value;
1274 <    varSingle, varDouble:
1275 <      AsDouble := Value;
1276 <    varCurrency:
1277 <      AsCurrency := Value;
1278 <    varBoolean:
1279 <      if Value then
1280 <        AsLong := ISC_TRUE
1281 <      else
1282 <        AsLong := ISC_FALSE;
1283 <    varDate:
1284 <      AsDateTime := Value;
1285 <    varOleStr, varString:
1286 <      AsString := Value;
1287 <    varArray:
1288 <      IBError(ibxeNotSupported, [nil]);
1289 <    varByRef, varDispatch, varError, varUnknown, varVariant:
1290 <      IBError(ibxeNotPermitted, [nil]);
1291 <  end;
1292 < end;
1293 <
1294 < procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1295 < var
1296 <  i: Integer;
1297 <  xvar: TIBXSQLVAR;
1298 <  sqlind: PShort;
1299 <  sqldata: PChar;
1300 <  local_sqllen: Integer;
1301 < begin
1302 <  for i := 0 to FParent.FCount - 1 do
1303 <    if FParent.FNames[i] = FName then
1304 <    begin
1305 <      xvar := FParent[i];
1306 <      sqlind := xvar.FXSQLVAR^.sqlind;
1307 <      sqldata := xvar.FXSQLVAR^.sqldata;
1308 <      Move(Value^, xvar.FXSQLVAR^, SizeOf(TXSQLVAR));
1309 <      xvar.FXSQLVAR^.sqlind := sqlind;
1310 <      xvar.FXSQLVAR^.sqldata := sqldata;
1311 <      if (Value^.sqltype and 1 = 1) then
1312 <      begin
1313 <        if (xvar.FXSQLVAR^.sqlind = nil) then
1314 <          IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1315 <        xvar.FXSQLVAR^.sqlind^ := Value^.sqlind^;
1316 <      end
1317 <      else
1318 <        if (xvar.FXSQLVAR^.sqlind <> nil) then
1319 <          ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1320 <      if ((xvar.FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1321 <        local_sqllen := xvar.FXSQLVAR^.sqllen + 2
1322 <      else
1323 <        local_sqllen := xvar.FXSQLVAR^.sqllen;
1324 <      FXSQLVAR^.sqlscale := Value^.sqlscale;
1325 <      IBAlloc(xvar.FXSQLVAR^.sqldata, 0, local_sqllen);
1326 <      Move(Value^.sqldata[0], xvar.FXSQLVAR^.sqldata[0], local_sqllen);
1327 <      xvar.FModified := True;
1328 <    end;
1329 < end;
1330 <
1331 < procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1332 < var
1333 <  i: Integer;
1334 <  xvar: TIBXSQLVAR;
1335 < begin
1336 <  if Value then
1337 <  begin
1338 <    if not IsNullable then
1339 <      IsNullable := True;
1340 <    for i := 0 to FParent.FCount - 1 do
1341 <      if FParent.FNames[i] = FName then
1342 <      begin
1343 <        xvar := FParent[i];
1344 <        if Assigned(xvar.FXSQLVAR^.sqlind) then
1345 <          xvar.FXSQLVAR^.sqlind^ := -1;
1346 <        xvar.FModified := True;
1347 <      end;
1348 <  end
1349 <  else
1350 <    if ((not Value) and IsNullable) then
1351 <    begin
1352 <      for i := 0 to FParent.FCount - 1 do
1353 <        if FParent.FNames[i] = FName then
1354 <        begin
1355 <          xvar := FParent[i];
1356 <          if Assigned(xvar.FXSQLVAR^.sqlind) then
1357 <            xvar.FXSQLVAR^.sqlind^ := 0;
1358 <          xvar.FModified := True;
1359 <        end;
1360 <    end;
1361 < end;
1362 <
1363 < procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1364 < var
1365 <  i: Integer;
1366 <  xvar: TIBXSQLVAR;
1367 < begin
1368 <  for i := 0 to FParent.FCount - 1 do
1369 <    if FParent.FNames[i] = FName then
1370 <    begin
1371 <      xvar := FParent[i];
1372 <      if (Value <> IsNullable) then
1373 <      begin
1374 <        if Value then
1375 <        begin
1376 <          xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype or 1;
1377 <          IBAlloc(xvar.FXSQLVAR^.sqlind, 0, SizeOf(Short));
1378 <        end
1379 <        else
1380 <        begin
1381 <          xvar.FXSQLVAR^.sqltype := xvar.FXSQLVAR^.sqltype and (not 1);
1382 <          ReallocMem(xvar.FXSQLVAR^.sqlind, 0);
1383 <        end;
1384 <      end;
1385 <    end;
1386 < end;
1387 <
1388 < procedure TIBXSQLVAR.Clear;
1389 < begin
1390 <  IsNull := true;
1391 < end;
1392 <
1393 <
1394 < { TIBXSQLDA }
1395 < constructor TIBXSQLDA.Create(Query: TIBSQL);
1396 < begin
1397 <  inherited Create;
1398 <  FSQL := Query;
1399 <  FNames := TStringList.Create;
1400 <  FSize := 0;
1401 <  FUniqueRelationName := '';
1402 < end;
1403 <
1404 < destructor TIBXSQLDA.Destroy;
1405 < var
1406 <  i: Integer;
1407 < begin
1408 <  FNames.Free;
1409 <  if FXSQLDA <> nil then
1410 <  begin
1411 <    for i := 0 to FSize - 1 do
1412 <    begin
1413 <      FreeMem(FXSQLVARs[i].FXSQLVAR^.sqldata);
1414 <      FreeMem(FXSQLVARs[i].FXSQLVAR^.sqlind);
1415 <      FXSQLVARs[i].Free ;
1416 <    end;
1417 <    FreeMem(FXSQLDA);
1418 <    FXSQLDA := nil;
1419 <    FXSQLVARs := nil;
1420 <  end;
1421 <  inherited Destroy;
1422 < end;
1423 <
1424 < procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
1425 < var
1426 <  fn: String;
1427 < begin
1428 <  fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
1429 <  while FNames.Count <= Idx do
1430 <    FNames.Add('');
1431 <  FNames[Idx] := fn;
1432 <  FXSQLVARs[Idx].FName := fn;
1433 <  FXSQLVARs[Idx].FIndex := Idx;
1434 < end;
1435 <
1436 < function TIBXSQLDA.GetModified: Boolean;
1437 < var
1438 <  i: Integer;
1439 < begin
1440 <  result := False;
1441 <  for i := 0 to FCount - 1 do
1442 <    if FXSQLVARs[i].Modified then
1443 <    begin
1444 <      result := True;
1445 <      exit;
1446 <    end;
1447 < end;
1448 <
1449 < function TIBXSQLDA.GetNames: String;
1450 < begin
1451 <  result := FNames.Text;
1452 < end;
1453 <
1454 < function TIBXSQLDA.GetRecordSize: Integer;
1455 < begin
1456 <  result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
1457 < end;
1458 <
1459 < function TIBXSQLDA.GetXSQLDA: PXSQLDA;
1460 < begin
1461 <  result := FXSQLDA;
1462 < end;
1463 <
1464 < function TIBXSQLDA.GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
1465 < begin
1466 <  if (Idx < 0) or (Idx >= FCount) then
1467 <    IBError(ibxeXSQLDAIndexOutOfRange, [nil]);
1468 <  result := FXSQLVARs[Idx]
1469 < end;
1470 <
1471 < function TIBXSQLDA.ByName(Idx: String): TIBXSQLVAR;
1472 < begin
1473 <  result := GetXSQLVARByName(Idx);
1474 <  if result = nil then
1475 <    IBError(ibxeFieldNotFound, [Idx]);
1476 < end;
1477 <
1478 < function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1479 < var
1480 <  s: String;
1481 <  i, Cnt: Integer;
1482 < begin
1483 <  s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
1484 <  i := 0;
1485 <  Cnt := FNames.Count;
1486 <  while (i < Cnt) and (FNames[i] <> s) do Inc(i);
1487 <  if i = Cnt then
1488 <    result := nil
1489 <  else
1490 <    result := GetXSQLVAR(i);
1491 < end;
1492 <
1493 < procedure TIBXSQLDA.Initialize;
1494 < var
1495 <  i, j, j_len: Integer;
1496 <  NamesWereEmpty: Boolean;
1497 <  st: String;
1498 <  bUnique: Boolean;
1499 < begin
1500 <  bUnique := True;
1501 <  NamesWereEmpty := (FNames.Count = 0);
1502 <  if FXSQLDA <> nil then
1503 <  begin
1504 <    for i := 0 to FCount - 1 do
1505 <    begin
1506 <      with FXSQLVARs[i].Data^ do
1507 <      begin
1508 <        if bUnique and (strpas(relname) <> '') then
1509 <        begin
1510 <          if FUniqueRelationName = '' then
1511 <            FUniqueRelationName := strpas(relname)
1512 <          else
1513 <            if strpas(relname) <> FUniqueRelationName then
1514 <            begin
1515 <              FUniqueRelationName := '';
1516 <              bUnique := False;
1517 <            end;
1518 <        end;
1519 <        if NamesWereEmpty then
1520 <        begin
1521 <          st := strpas(aliasname);
1522 <          if st = '' then
1523 <          begin
1524 <            st := 'F_'; {do not localize}
1525 <            aliasname_length := 2;
1526 <            j := 1; j_len := 1;
1527 <            StrPCopy(aliasname, st + IntToStr(j));
1528 <          end
1529 <          else
1530 <          begin
1531 <            StrPCopy(aliasname, st);
1532 <            j := 0; j_len := 0;
1533 <          end;
1534 <          while GetXSQLVARByName(strpas(aliasname)) <> nil do
1535 <          begin
1536 <            Inc(j); j_len := Length(IntToStr(j));
1537 <            if j_len + aliasname_length > 31 then
1538 <              StrPCopy(aliasname,
1539 <                       Copy(st, 1, 31 - j_len) +
1540 <                       IntToStr(j))
1541 <            else
1542 <              StrPCopy(aliasname, st + IntToStr(j));
1543 <          end;
1544 <          Inc(aliasname_length, j_len);
1545 <          AddName(strpas(aliasname), i);
1546 <        end;
1547 <        case sqltype and (not 1) of
1548 <          SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1549 <          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
1550 <          SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1551 <            if (sqllen = 0) then
1552 <              { Make sure you get a valid pointer anyway
1553 <               select '' from foo }
1554 <              IBAlloc(sqldata, 0, 1)
1555 <            else
1556 <              IBAlloc(sqldata, 0, sqllen)
1557 <          end;
1558 <          SQL_VARYING: begin
1559 <            IBAlloc(sqldata, 0, sqllen + 2);
1560 <          end;
1561 <          else
1562 <            IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
1563 <        end;
1564 <        if (sqltype and 1 = 1) then
1565 <          IBAlloc(sqlind, 0, SizeOf(Short))
1566 <        else
1567 <          if (sqlind <> nil) then
1568 <            ReallocMem(sqlind, 0);
1569 <      end;
1570 <    end;
1571 <  end;
1572 < end;
1573 <
1574 < procedure TIBXSQLDA.SetCount(Value: Integer);
1575 < var
1576 <  i, OldSize: Integer;
1577 <  p : PXSQLVAR;
1578 < begin
1579 <  FNames.Clear;
1580 <  FCount := Value;
1581 <  if FCount = 0 then
1582 <    FUniqueRelationName := ''
1583 <  else
1584 <  begin
1585 <    if FSize > 0 then
1586 <      OldSize := XSQLDA_LENGTH(FSize)
1587 <    else
1588 <      OldSize := 0;
1589 <    if FCount > FSize then
1590 <    begin
1591 <      IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(FCount));
1592 <      SetLength(FXSQLVARs, FCount);
1593 <      FXSQLDA^.version := SQLDA_VERSION1;
1594 <      p := @FXSQLDA^.sqlvar[0];
1595 <      for i := 0 to FCount - 1 do
1596 <      begin
1597 <        if i >= FSize then
1598 <          FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1599 <        FXSQLVARs[i].FXSQLVAR := p;
1600 <        p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1601 <      end;
1602 <      FSize := FCount;
1603 <    end;
1604 <    if FSize > 0 then
1605 <    begin
1606 <      FXSQLDA^.sqln := Value;
1607 <      FXSQLDA^.sqld := Value;
1608 <    end;
1609 <  end;
1610 < end;
1611 <
1612 < { TIBOutputDelimitedFile }
1613 <
1614 < destructor TIBOutputDelimitedFile.Destroy;
1615 < begin
1616 < {$IFDEF UNIX}
1617 <  if FHandle <> -1 then
1618 <     fpclose(FHandle);
1619 < {$ELSE}
1620 <  if FHandle <> 0 then
1621 <  begin
1622 <    FlushFileBuffers(FHandle);
1623 <    CloseHandle(FHandle);
1624 <  end;
1625 < {$ENDIF}
1626 <  inherited Destroy;
1627 < end;
1628 <
1629 < procedure TIBOutputDelimitedFile.ReadyFile;
1630 < var
1631 <  i: Integer;
1632 <  {$IFDEF UNIX}
1633 <  BytesWritten: cint;
1634 <  {$ELSE}
1635 <  BytesWritten: DWORD;
1636 <  {$ENDIF}
1637 <  st: string;
1638 < begin
1639 <  if FColDelimiter = '' then
1640 <    FColDelimiter := TAB;
1641 <  if FRowDelimiter = '' then
1642 <    FRowDelimiter := CRLF;
1643 <  {$IFDEF UNIX}
1644 <  FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1645 <  {$ELSE}
1646 <  FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1647 <                        FILE_ATTRIBUTE_NORMAL, 0);
1648 <  if FHandle = INVALID_HANDLE_VALUE then
1649 <    FHandle := 0;
1650 <  {$ENDIF}
1651 <  if FOutputTitles then
1652 <  begin
1653 <    for i := 0 to Columns.Count - 1 do
1654 <      if i = 0 then
1655 <        st := strpas(Columns[i].Data^.aliasname)
1656 <      else
1657 <        st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1658 <    st := st + FRowDelimiter;
1659 <    {$IFDEF UNIX}
1660 <    if FHandle <> -1 then
1661 <       BytesWritten := FpWrite(FHandle,st[1],Length(st));
1662 <    if BytesWritten = -1 then
1663 <       raise Exception.Create('File Write Error');
1664 <    {$ELSE}
1665 <    WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1666 <    {$ENDIF}
1667 <  end;
1668 < end;
1669 <
1670 < function TIBOutputDelimitedFile.WriteColumns: Boolean;
1671 < var
1672 <  i: Integer;
1673 <  {$IFDEF UNIX}
1674 <  BytesWritten: cint;
1675 <  {$ELSE}
1676 <  BytesWritten: DWORD;
1677 <  {$ENDIF}
1678 <  st: string;
1679 < begin
1680 <  result := False;
1681 <  {$IFDEF UNIX}
1682 <  if FHandle <> -1 then
1683 <  {$ELSE}
1684 <  if FHandle <> 0 then
1685 <  {$ENDIF}
1686 <  begin
1687 <    st := '';
1688 <    for i := 0 to Columns.Count - 1 do
1689 <    begin
1690 <      if i > 0 then
1691 <        st := st + FColDelimiter;
1692 <      st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1693 <    end;
1694 <    st := st + FRowDelimiter;
1695 <  {$IFDEF UNIX}
1696 <    BytesWritten := FpWrite(FHandle,st[1],Length(st));
1697 <  {$ELSE}
1698 <    WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1699 <  {$ENDIF}
1700 <    if BytesWritten = DWORD(Length(st)) then
1701 <      result := True;
1702 <  end
1703 < end;
1704 <
1705 < { TIBInputDelimitedFile }
1706 <
1707 < destructor TIBInputDelimitedFile.Destroy;
1708 < begin
1709 <  FFile.Free;
1710 <  inherited Destroy;
1711 < end;
1712 <
1713 < function TIBInputDelimitedFile.GetColumn(var Col: string): Integer;
1714 < var
1715 <  c: Char;
1716 <  BytesRead: Integer;
1717 <
1718 <  procedure ReadInput;
1719 <  begin
1720 <    if FLookAhead <> NULL_TERMINATOR then
1721 <    begin
1722 <      c := FLookAhead;
1723 <      BytesRead := 1;
1724 <      FLookAhead := NULL_TERMINATOR;
1725 <    end else
1726 <      BytesRead := FFile.Read(c, 1);
1727 <  end;
1728 <
1729 <  procedure CheckCRLF(Delimiter: string);
1730 <  begin
1731 <    if (c = CR) and (Pos(LF, Delimiter) > 0) then {mbcs ok}
1732 <    begin
1733 <      BytesRead := FFile.Read(c, 1);
1734 <      if (BytesRead = 1) and (c <> #10) then
1735 <        FLookAhead := c
1736 <    end;
1737 <  end;
1738 <
1739 < begin
1740 <  Col := '';
1741 <  result := 0;
1742 <  ReadInput;
1743 <  while BytesRead <> 0 do begin
1744 <    if Pos(c, FColDelimiter) > 0 then {mbcs ok}
1745 <    begin
1746 <      CheckCRLF(FColDelimiter);
1747 <      result := 1;
1748 <      break;
1749 <    end else if Pos(c, FRowDelimiter) > 0 then {mbcs ok}
1750 <    begin
1751 <      CheckCRLF(FRowDelimiter);
1752 <      result := 2;
1753 <      break;
1754 <    end else
1755 <      Col := Col + c;
1756 <    ReadInput;
1757 <  end;
1758 < end;
1759 <
1760 < function TIBInputDelimitedFile.ReadParameters: Boolean;
1761 < var
1762 <  i, curcol: Integer;
1763 <  Col: string;
1764 < begin
1765 <  result := False;
1766 <  if not FEOF then begin
1767 <    curcol := 0;
1768 <    repeat
1769 <      i := GetColumn(Col);
1770 <      if (i = 0) then
1771 <        FEOF := True;
1772 <      if (curcol < Params.Count) then
1773 <      begin
1774 <        try
1775 <          if (Col = '') and
1776 <             (ReadBlanksAsNull) then
1777 <            Params[curcol].IsNull := True
1778 <          else
1779 <            Params[curcol].AsString := Col;
1780 <          Inc(curcol);
1781 <        except
1782 <          on E: Exception do begin
1783 <            if not (FEOF and (curcol = Params.Count)) then
1784 <              raise;
1785 <          end;
1786 <        end;
1787 <      end;
1788 <    until (FEOF) or (i = 2);
1789 <    result := ((FEOF) and (curcol = Params.Count)) or
1790 <              (not FEOF);
1791 <  end;
1792 < end;
1793 <
1794 < procedure TIBInputDelimitedFile.ReadyFile;
1795 < begin
1796 <  if FColDelimiter = '' then
1797 <    FColDelimiter := TAB;
1798 <  if FRowDelimiter = '' then
1799 <    FRowDelimiter := CRLF;
1800 <  FLookAhead := NULL_TERMINATOR;
1801 <  FEOF := False;
1802 <  if FFile <> nil then
1803 <    FFile.Free;
1804 <  FFile := TFileStream.Create(FFilename, fmOpenRead or fmShareDenyWrite);
1805 <  if FSkipTitles then
1806 <    ReadParameters;
1807 < end;
1808 <
1809 < { TIBOutputRawFile }
1810 < destructor TIBOutputRawFile.Destroy;
1811 < begin
1812 < {$IFDEF UNIX}
1813 <  if FHandle <> -1 then
1814 <     fpclose(FHandle);
1815 < {$ELSE}
1816 <  if FHandle <> 0 then
1817 <  begin
1818 <    FlushFileBuffers(FHandle);
1819 <    CloseHandle(FHandle);
1820 <  end;
1821 < {$ENDIF}
1822 <  inherited Destroy;
1823 < end;
1824 <
1825 < procedure TIBOutputRawFile.ReadyFile;
1826 < begin
1827 <  {$IFDEF UNIX}
1828 <  FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1829 <  {$ELSE}
1830 <  FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1831 <                        FILE_ATTRIBUTE_NORMAL, 0);
1832 <  if FHandle = INVALID_HANDLE_VALUE then
1833 <    FHandle := 0;
1834 <  {$ENDIF}
1835 < end;
1836 <
1837 < function TIBOutputRawFile.WriteColumns: Boolean;
1838 < var
1839 <  i: Integer;
1840 <  BytesWritten: DWord;
1841 < begin
1842 <  result := False;
1843 <  if FHandle <> 0 then
1844 <  begin
1845 <    for i := 0 to Columns.Count - 1 do
1846 <    begin
1847 <      {$IFDEF UNIX}
1848 <      BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
1849 <      {$ELSE}
1850 <      WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
1851 <                BytesWritten, nil);
1852 <      {$ENDIF}
1853 <      if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
1854 <        exit;
1855 <    end;
1856 <    result := True;
1857 <  end;
1858 < end;
1859 <
1860 < { TIBInputRawFile }
1861 < destructor TIBInputRawFile.Destroy;
1862 < begin
1863 < {$IFDEF UNIX}
1864 <  if FHandle <> -1 then
1865 <     fpclose(FHandle);
1866 < {$ELSE}
1867 <  if FHandle <> 0 then
1868 <    CloseHandle(FHandle);
1869 < {$ENDIF}
1870 <  inherited Destroy;
1871 < end;
1872 <
1873 < function TIBInputRawFile.ReadParameters: Boolean;
1874 < var
1875 <  i: Integer;
1876 <  BytesRead: DWord;
1877 < begin
1878 <  result := False;
1879 < {$IFDEF UNIX}
1880 <  if FHandle <> -1 then
1881 < {$ELSE}
1882 <  if FHandle <> 0 then
1883 < {$ENDIF}
1884 <  begin
1885 <    for i := 0 to Params.Count - 1 do
1886 <    begin
1887 <      {$IFDEF UNIX}
1888 <      BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
1889 <      {$ELSE}
1890 <      ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
1891 <               BytesRead, nil);
1892 <      {$ENDIF}
1893 <      if BytesRead <> DWORD(Params[i].Data^.sqllen) then
1894 <        exit;
1895 <    end;
1896 <    result := True;
1897 <  end;
1898 < end;
1899 <
1900 < procedure TIBInputRawFile.ReadyFile;
1901 < begin
1902 < {$IFDEF UNIX}
1903 <  if FHandle <> -1 then
1904 <     fpclose(FHandle);
1905 <  FHandle := FpOpen(Filename,O_RdOnly);
1906 <  if FHandle = -1 then
1907 <     raise Exception.CreateFmt('Unable to open file %s',[Filename]);
1908 < {$ELSE}
1909 <  if FHandle <> 0 then
1910 <    CloseHandle(FHandle);
1911 <  FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
1912 <                        FILE_FLAG_SEQUENTIAL_SCAN, 0);
1913 <  if FHandle = INVALID_HANDLE_VALUE then
1914 <    FHandle := 0;
1915 < {$ENDIF}
1916 < end;
1917 <
1918 < { TIBSQL }
1919 < constructor TIBSQL.Create(AOwner: TComponent);
1920 < begin
1921 <  inherited Create(AOwner);
1922 <  FIBLoaded := False;
1923 <  CheckIBLoaded;
1924 <  FIBLoaded := True;
1925 <  FGenerateParamNames := False;
1926 <  FGoToFirstRecordOnExecute := True;
1927 <  FBase := TIBBase.Create(Self);
1928 <  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
1929 <  FBase.BeforeTransactionEnd := BeforeTransactionEnd;
1930 <  FBOF := False;
1931 <  FEOF := False;
1932 <  FPrepared := False;
1933 <  FRecordCount := 0;
1934 <  FSQL := TStringList.Create;
1935 <  TStringList(FSQL).OnChanging := SQLChanging;
1936 <  FProcessedSQL := TStringList.Create;
1937 <  FHandle := nil;
1938 <  FSQLParams := TIBXSQLDA.Create(self);
1939 <  FSQLRecord := TIBXSQLDA.Create(self);
1940 <  FSQLType := SQLUnknown;
1941 <  FParamCheck := True;
1942 <  FCursor := Name + RandomString(8);
1943 <  if AOwner is TIBDatabase then
1944 <    Database := TIBDatabase(AOwner)
1945 <  else
1946 <    if AOwner is TIBTransaction then
1947 <      Transaction := TIBTransaction(AOwner);
1948 < end;
1949 <
1950 < destructor TIBSQL.Destroy;
1951 < begin
1952 <  if FIBLoaded then
1953 <  begin
1954 <    if (FOpen) then
1955 <      Close;
1956 <    if (FHandle <> nil) then
1957 <      FreeHandle;
1958 <    FSQL.Free;
1959 <    FProcessedSQL.Free;
1960 <    FBase.Free;
1961 <    FSQLParams.Free;
1962 <    FSQLRecord.Free;
1963 <  end;
1964 <  inherited Destroy;
1965 < end;
1966 <
1967 < procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
1968 < begin
1969 <  if not Prepared then
1970 <    Prepare;
1971 <  InputObject.FParams := Self.FSQLParams;
1972 <  InputObject.ReadyFile;
1973 <  if FSQLType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
1974 <    while InputObject.ReadParameters do
1975 <      ExecQuery;
1976 < end;
1977 <
1978 < procedure TIBSQL.BatchOutput(OutputObject: TIBBatchOutput);
1979 < begin
1980 <  CheckClosed;
1981 <  if not Prepared then
1982 <    Prepare;
1983 <  if FSQLType = SQLSelect then begin
1984 <    try
1985 <      ExecQuery;
1986 <      OutputObject.FColumns := Self.FSQLRecord;
1987 <      OutputObject.ReadyFile;
1988 <      if not FGoToFirstRecordOnExecute then
1989 <        Next;
1990 <      while (not Eof) and (OutputObject.WriteColumns) do
1991 <        Next;
1992 <    finally
1993 <      Close;
1994 <    end;
1995 <  end;
1996 < end;
1997 <
1998 < procedure TIBSQL.CheckClosed;
1999 < begin
2000 <  if FOpen then IBError(ibxeSQLOpen, [nil]);
2001 < end;
2002 <
2003 < procedure TIBSQL.CheckOpen;
2004 < begin
2005 <  if not FOpen then IBError(ibxeSQLClosed, [nil]);
2006 < end;
2007 <
2008 < procedure TIBSQL.CheckValidStatement;
2009 < begin
2010 <  FBase.CheckTransaction;
2011 <  if (FHandle = nil) then
2012 <    IBError(ibxeInvalidStatementHandle, [nil]);
2013 < end;
2014 <
2015 < procedure TIBSQL.Close;
2016 < var
2017 <  isc_res: ISC_STATUS;
2018 < begin
2019 <  try
2020 <    if (FHandle <> nil) and (SQLType = SQLSelect) and FOpen then begin
2021 <      isc_res := Call(
2022 <                   isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
2023 <                   False);
2024 <      if (StatusVector^ = 1) and (isc_res > 0) and
2025 <        not CheckStatusVector(
2026 <              [isc_bad_stmt_handle, isc_dsql_cursor_close_err]) then
2027 <        IBDatabaseError;
2028 <    end;
2029 <  finally
2030 <    FEOF := False;
2031 <    FBOF := False;
2032 <    FOpen := False;
2033 <    FRecordCount := 0;
2034 <  end;
2035 < end;
2036 <
2037 < function TIBSQL.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
2038 < begin
2039 <  result := 0;
2040 < if Transaction <> nil then
2041 <    result := Transaction.Call(ErrCode, RaiseError)
2042 <  else
2043 <  if RaiseError and (ErrCode > 0) then
2044 <    IBDataBaseError;
2045 < end;
2046 <
2047 < function TIBSQL.Current: TIBXSQLDA;
2048 < begin
2049 <  result := FSQLRecord;
2050 < end;
2051 <
2052 < function TIBSQL.GetFieldCount: integer;
2053 < begin
2054 <  Result := FSQLRecord.Count
2055 < end;
2056 <
2057 < procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
2058 < begin
2059 <  if (FHandle <> nil) then begin
2060 <    Close;
2061 <    FreeHandle;
2062 <  end;
2063 < end;
2064 <
2065 < procedure TIBSQL.ExecQuery;
2066 < var
2067 <  fetch_res: ISC_STATUS;
2068 < begin
2069 <  CheckClosed;
2070 <  if not Prepared then Prepare;
2071 <  CheckValidStatement;
2072 <  case FSQLType of
2073 <    SQLSelect: begin
2074 <      Call(isc_dsql_execute2(StatusVector,
2075 <                            TRHandle,
2076 <                            @FHandle,
2077 <                            Database.SQLDialect,
2078 <                            FSQLParams.AsXSQLDA,
2079 <                            nil), True);
2080 <      Call(
2081 <        isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
2082 <        True);
2083 <      FOpen := True;
2084 <      FBOF := True;
2085 <      FEOF := False;
2086 <      FRecordCount := 0;
2087 <      if FGoToFirstRecordOnExecute then
2088 <        Next;
2089 <    end;
2090 <    SQLExecProcedure: begin
2091 <      fetch_res := Call(isc_dsql_execute2(StatusVector,
2092 <                            TRHandle,
2093 <                            @FHandle,
2094 <                            Database.SQLDialect,
2095 <                            FSQLParams.AsXSQLDA,
2096 <                            FSQLRecord.AsXSQLDA), False);
2097 <      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2098 <      begin
2099 <         { Sometimes a prepared stored procedure appears to get
2100 <           off sync on the server ....This code is meant to try
2101 <           to work around the problem simply by "retrying". This
2102 <           need to be reproduced and fixed.
2103 <         }
2104 <        isc_dsql_prepare(StatusVector, TRHandle, @FHandle, 0,
2105 <                         PChar(FProcessedSQL.Text), 1, nil);
2106 <        Call(isc_dsql_execute2(StatusVector,
2107 <                            TRHandle,
2108 <                            @FHandle,
2109 <                            Database.SQLDialect,
2110 <                            FSQLParams.AsXSQLDA,
2111 <                            FSQLRecord.AsXSQLDA), True);
2112 <      end;
2113 <    end
2114 <    else
2115 <      Call(isc_dsql_execute(StatusVector,
2116 <                           TRHandle,
2117 <                           @FHandle,
2118 <                           Database.SQLDialect,
2119 <                           FSQLParams.AsXSQLDA), True)
2120 <  end;
2121 <  if not (csDesigning in ComponentState) then
2122 <    MonitorHook.SQLExecute(Self);
2123 < end;
2124 <
2125 < function TIBSQL.GetEOF: Boolean;
2126 < begin
2127 <  result := FEOF or not FOpen;
2128 < end;
2129 <
2130 < function TIBSQL.FieldByName(FieldName: String): TIBXSQLVAR;
2131 < var
2132 <  i: Integer;
2133 < begin
2134 <  i := GetFieldIndex(FieldName);
2135 <  if (i < 0) then
2136 <    IBError(ibxeFieldNotFound, [FieldName]);
2137 <  result := GetFields(i);
2138 < end;
2139 <
2140 < function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2141 < begin
2142 <  Result := Params.ByName(ParamName);
2143 < end;
2144 <
2145 < function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2146 < begin
2147 <  if (Idx < 0) or (Idx >= FSQLRecord.Count) then
2148 <    IBError(ibxeFieldNotFound, [IntToStr(Idx)]);
2149 <  result := FSQLRecord[Idx];
2150 < end;
2151 <
2152 < function TIBSQL.GetFieldIndex(FieldName: String): Integer;
2153 < begin
2154 <  if (FSQLRecord.GetXSQLVarByName(FieldName) = nil) then
2155 <    result := -1
2156 <  else
2157 <    result := FSQLRecord.GetXSQLVarByName(FieldName).Index;
2158 < end;
2159 <
2160 < function TIBSQL.Next: TIBXSQLDA;
2161 < var
2162 <  fetch_res: ISC_STATUS;
2163 < begin
2164 <  result := nil;
2165 <  if not FEOF then begin
2166 <    CheckOpen;
2167 <    { Go to the next record... }
2168 <    fetch_res :=
2169 <      Call(isc_dsql_fetch(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.AsXSQLDA), False);
2170 <    if (fetch_res = 100) or (CheckStatusVector([isc_dsql_cursor_err])) then begin
2171 <      FEOF := True;
2172 <    end else if (fetch_res > 0) then begin
2173 <      try
2174 <        IBDataBaseError;
2175 <      except
2176 <        Close;
2177 <        raise;
2178 <      end;
2179 <    end else begin
2180 <      Inc(FRecordCount);
2181 <      FBOF := False;
2182 <      result := FSQLRecord;
2183 <    end;
2184 <    if not (csDesigning in ComponentState) then
2185 <      MonitorHook.SQLFetch(Self);
2186 <  end;
2187 < end;
2188 <
2189 < procedure TIBSQL.FreeHandle;
2190 < var
2191 <  isc_res: ISC_STATUS;
2192 < begin
2193 <  try
2194 <    { The following two lines merely set the SQLDA count
2195 <     variable FCount to 0, but do not deallocate
2196 <     That way the allocations can be reused for
2197 <     a new query sring in the same SQL instance }
2198 <    FSQLRecord.Count := 0;
2199 <    FSQLParams.Count := 0;
2200 <    if FHandle <> nil then begin
2201 <      isc_res :=
2202 <        Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
2203 <      if (StatusVector^ = 1) and (isc_res > 0) and (isc_res <> isc_bad_stmt_handle) then
2204 <        IBDataBaseError;
2205 <    end;
2206 <  finally
2207 <    FPrepared := False;
2208 <    FHandle := nil;
2209 <  end;
2210 < end;
2211 <
2212 < function TIBSQL.GetDatabase: TIBDatabase;
2213 < begin
2214 <  result := FBase.Database;
2215 < end;
2216 <
2217 < function TIBSQL.GetDBHandle: PISC_DB_HANDLE;
2218 < begin
2219 <  result := FBase.DBHandle;
2220 < end;
2221 <
2222 < function TIBSQL.GetPlan: String;
2223 < var
2224 <  result_buffer: array[0..16384] of Char;
2225 <  result_length, i: Integer;
2226 <  info_request: Char;
2227 < begin
2228 <  if (not Prepared) or
2229 <     (not (FSQLType in [SQLSelect, SQLSelectForUpdate,
2230 <       {TODO: SQLExecProcedure, }
2231 <       SQLUpdate, SQLDelete])) then
2232 <    result := ''
2233 <  else begin
2234 <    info_request := Char(isc_info_sql_get_plan);
2235 <    Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2236 <                           SizeOf(result_buffer), result_buffer), True);
2237 <    if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2238 <      IBError(ibxeUnknownError, [nil]);
2239 <    result_length := isc_vax_integer(@result_buffer[1], 2);
2240 <    SetString(result, nil, result_length);
2241 <    for i := 1 to result_length do
2242 <      result[i] := result_buffer[i + 2];
2243 <    result := Trim(result);
2244 <  end;
2245 < end;
2246 <
2247 < function TIBSQL.GetRecordCount: Integer;
2248 < begin
2249 <  result := FRecordCount;
2250 < end;
2251 <
2252 < function TIBSQL.GetRowsAffected: integer;
2253 < var
2254 <  result_buffer: array[0..1048] of Char;
2255 <  info_request: Char;
2256 < begin
2257 <  if not Prepared then
2258 <    result := -1
2259 <  else begin
2260 <    info_request := Char(isc_info_sql_records);
2261 <    if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2262 <                         SizeOf(result_buffer), result_buffer) > 0 then
2263 <      IBDatabaseError;
2264 <    if (result_buffer[0] <> Char(isc_info_sql_records)) then
2265 <      result := -1
2266 <    else
2267 <    case SQLType of
2268 <    SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2269 <    SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2270 <    SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2271 <    else         Result := -1 ;
2272 <    end ;
2273 <  end;
2274 < end;
2275 <
2276 < function TIBSQL.GetSQLParams: TIBXSQLDA;
2277 < begin
2278 <  if not Prepared then
2279 <    Prepare;
2280 <  result := FSQLParams;
2281 < end;
2282 <
2283 < function TIBSQL.GetTransaction: TIBTransaction;
2284 < begin
2285 <  result := FBase.Transaction;
2286 < end;
2287 <
2288 < function TIBSQL.GetTRHandle: PISC_TR_HANDLE;
2289 < begin
2290 <  result := FBase.TRHandle;
2291 < end;
2292 <
2293 < {
2294 < Preprocess SQL
2295 < Using FSQL, process the typed SQL and put the process SQL
2296 < in FProcessedSQL and parameter names in FSQLParams
2297 < }
2298 < procedure TIBSQL.PreprocessSQL;
2299 < var
2300 <  cCurChar, cNextChar, cQuoteChar: Char;
2301 <  sSQL, sProcessedSQL, sParamName: String;
2302 <  i, iLenSQL, iSQLPos: Integer;
2303 <  iCurState, iCurParamState: Integer;
2304 <  iParamSuffix: Integer;
2305 <  slNames: TStrings;
2306 <
2307 < const
2308 <  DefaultState = 0;
2309 <  CommentState = 1;
2310 <  QuoteState = 2;
2311 <  ParamState = 3;
2312 <  ParamDefaultState = 0;
2313 <  ParamQuoteState = 1;
2314 <
2315 <  procedure AddToProcessedSQL(cChar: Char);
2316 <  begin
2317 <    sProcessedSQL[iSQLPos] := cChar;
2318 <    Inc(iSQLPos);
2319 <  end;
2320 <
2321 < begin
2322 <  slNames := TStringList.Create;
2323 <  try
2324 <    { Do some initializations of variables }
2325 <    iParamSuffix := 0;
2326 <    cQuoteChar := '''';
2327 <    sSQL := FSQL.Text;
2328 <    iLenSQL := Length(sSQL);
2329 <    SetString(sProcessedSQL, nil, iLenSQL + 1);
2330 <    i := 1;
2331 <    iSQLPos := 1;
2332 <    iCurState := DefaultState;
2333 <    iCurParamState := ParamDefaultState;
2334 <    { Now, traverse through the SQL string, character by character,
2335 <     picking out the parameters and formatting correctly for InterBase }
2336 <    while (i <= iLenSQL) do begin
2337 <      { Get the current token and a look-ahead }
2338 <      cCurChar := sSQL[i];
2339 <      if i = iLenSQL then
2340 <        cNextChar := #0
2341 <      else
2342 <        cNextChar := sSQL[i + 1];
2343 <      { Now act based on the current state }
2344 <      case iCurState of
2345 <        DefaultState: begin
2346 <          case cCurChar of
2347 <            '''', '"': begin
2348 <              cQuoteChar := cCurChar;
2349 <              iCurState := QuoteState;
2350 <            end;
2351 <            '?', ':': begin
2352 <              iCurState := ParamState;
2353 <              AddToProcessedSQL('?');
2354 <            end;
2355 <            '/': if (cNextChar = '*') then begin
2356 <              AddToProcessedSQL(cCurChar);
2357 <              Inc(i);
2358 <              iCurState := CommentState;
2359 <            end;
2360 <          end;
2361 <        end;
2362 <        CommentState: begin
2363 <          if (cNextChar = #0) then
2364 <            IBError(ibxeSQLParseError, [SEOFInComment])
2365 <          else if (cCurChar = '*') then begin
2366 <            if (cNextChar = '/') then
2367 <              iCurState := DefaultState;
2368 <          end;
2369 <        end;
2370 <        QuoteState: begin
2371 <          if cNextChar = #0 then
2372 <            IBError(ibxeSQLParseError, [SEOFInString])
2373 <          else if (cCurChar = cQuoteChar) then begin
2374 <            if (cNextChar = cQuoteChar) then begin
2375 <              AddToProcessedSQL(cCurChar);
2376 <              Inc(i);
2377 <            end else
2378 <              iCurState := DefaultState;
2379 <          end;
2380 <        end;
2381 <        ParamState:
2382 <        begin
2383 <          { collect the name of the parameter }
2384 <          if iCurParamState = ParamDefaultState then
2385 <          begin
2386 <            if cCurChar = '"' then
2387 <              iCurParamState := ParamQuoteState
2388 <            else if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2389 <                sParamName := sParamName + cCurChar
2390 <            else if FGenerateParamNames then
2391 <            begin
2392 <              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2393 <              Inc(iParamSuffix);
2394 <              iCurState := DefaultState;
2395 <              slNames.Add(sParamName);
2396 <              sParamName := '';
2397 <            end
2398 <            else
2399 <              IBError(ibxeSQLParseError, [SParamNameExpected]);
2400 <          end
2401 <          else begin
2402 <            { determine if Quoted parameter name is finished }
2403 <            if cCurChar = '"' then
2404 <            begin
2405 <              Inc(i);
2406 <              slNames.Add(sParamName);
2407 <              SParamName := '';
2408 <              iCurParamState := ParamDefaultState;
2409 <              iCurState := DefaultState;
2410 <            end
2411 <            else
2412 <              sParamName := sParamName + cCurChar
2413 <          end;
2414 <          { determine if the unquoted parameter name is finished }
2415 <          if (iCurParamState <> ParamQuoteState) and
2416 <            (iCurState <> DefaultState) then
2417 <          begin
2418 <            if not (cNextChar in ['A'..'Z', 'a'..'z',
2419 <                                  '0'..'9', '_', '$']) then begin
2420 <              Inc(i);
2421 <              iCurState := DefaultState;
2422 <              slNames.Add(sParamName);
2423 <              sParamName := '';
2424 <            end;
2425 <          end;
2426 <        end;
2427 <      end;
2428 <      if iCurState <> ParamState then
2429 <        AddToProcessedSQL(sSQL[i]);
2430 <      Inc(i);
2431 <    end;
2432 <    AddToProcessedSQL(#0);
2433 <    FSQLParams.Count := slNames.Count;
2434 <    for i := 0 to slNames.Count - 1 do
2435 <      FSQLParams.AddName(slNames[i], i);
2436 <    FProcessedSQL.Text := sProcessedSQL;
2437 <  finally
2438 <    slNames.Free;
2439 <  end;
2440 < end;
2441 <
2442 < procedure TIBSQL.SetDatabase(Value: TIBDatabase);
2443 < begin
2444 <  FBase.Database := Value;
2445 < end;
2446 <
2447 < procedure TIBSQL.Prepare;
2448 < var
2449 <  stmt_len: Integer;
2450 <  res_buffer: array[0..7] of Char;
2451 <  type_item: Char;
2452 < begin
2453 <  CheckClosed;
2454 <  FBase.CheckDatabase;
2455 <  FBase.CheckTransaction;
2456 <  if FPrepared then
2457 <    exit;
2458 <  if (FSQL.Text = '') then
2459 <    IBError(ibxeEmptyQuery, [nil]);
2460 <  if not ParamCheck then
2461 <    FProcessedSQL.Text := FSQL.Text
2462 <  else
2463 <    PreprocessSQL;
2464 <  if (FProcessedSQL.Text = '') then
2465 <    IBError(ibxeEmptyQuery, [nil]);
2466 <  try
2467 <    Call(isc_dsql_alloc_statement2(StatusVector, DBHandle,
2468 <                                    @FHandle), True);
2469 <    Call(isc_dsql_prepare(StatusVector, TRHandle, @FHandle, 0,
2470 <               PChar(FProcessedSQL.Text), Database.SQLDialect, nil), True);
2471 <    { After preparing the statement, query the stmt type and possibly
2472 <      create a FSQLRecord "holder" }
2473 <    { Get the type of the statement }
2474 <    type_item := Char(isc_info_sql_stmt_type);
2475 <    Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2476 <                         SizeOf(res_buffer), res_buffer), True);
2477 <    if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2478 <      IBError(ibxeUnknownError, [nil]);
2479 <    stmt_len := isc_vax_integer(@res_buffer[1], 2);
2480 <    FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
2481 <    { Done getting the type }
2482 <    case FSQLType of
2483 <      SQLGetSegment,
2484 <      SQLPutSegment,
2485 <      SQLStartTransaction: begin
2486 <        FreeHandle;
2487 <        IBError(ibxeNotPermitted, [nil]);
2488 <      end;
2489 <      SQLCommit,
2490 <      SQLRollback,
2491 <      SQLDDL, SQLSetGenerator,
2492 <      SQLInsert, SQLUpdate, SQLDelete, SQLSelect, SQLSelectForUpdate,
2493 <      SQLExecProcedure: begin
2494 <        { We already know how many inputs there are, so... }
2495 <        if (FSQLParams.FXSQLDA <> nil) and
2496 <           (Call(isc_dsql_describe_bind(StatusVector, @FHandle, Database.SQLDialect,
2497 <                                        FSQLParams.FXSQLDA), False) > 0) then
2498 <          IBDataBaseError;
2499 <        FSQLParams.Initialize;
2500 <        if FSQLType in [SQLSelect, SQLSelectForUpdate,
2501 <                        SQLExecProcedure] then begin
2502 <          { Allocate an initial output descriptor (with one column) }
2503 <          FSQLRecord.Count := 1;
2504 <          { Using isc_dsql_describe, get the right size for the columns... }
2505 <          Call(isc_dsql_describe(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.FXSQLDA), True);
2506 <          if FSQLRecord.FXSQLDA^.sqld > FSQLRecord.FXSQLDA^.sqln then begin
2507 <            FSQLRecord.Count := FSQLRecord.FXSQLDA^.sqld;
2508 <            Call(isc_dsql_describe(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.FXSQLDA), True);
2509 <          end else if FSQLRecord.FXSQLDA^.sqld = 0 then
2510 <            FSQLRecord.Count := 0;
2511 <          FSQLRecord.Initialize;
2512 <        end;
2513 <      end;
2514 <    end;
2515 <    FPrepared := True;
2516 <    if not (csDesigning in ComponentState) then
2517 <      MonitorHook.SQLPrepare(Self);
2518 <  except
2519 <    on E: Exception do begin
2520 <      if (FHandle <> nil) then
2521 <        FreeHandle;
2522 <      raise;
2523 <    end;
2524 <  end;
2525 < end;
2526 <
2527 < function TIBSQL.GetUniqueRelationName: String;
2528 < begin
2529 <  if FPrepared and (FSQLType = SQLSelect) then
2530 <    result := FSQLRecord.UniqueRelationName
2531 <  else
2532 <    result := '';
2533 < end;
2534 <
2535 < procedure TIBSQL.SetSQL(Value: TStrings);
2536 < begin
2537 <  if FSQL.Text <> Value.Text then
2538 <  begin
2539 <    FSQL.BeginUpdate;
2540 <    try
2541 <      FSQL.Assign(Value);
2542 <    finally
2543 <      FSQL.EndUpdate;
2544 <    end;
2545 <  end;
2546 < end;
2547 <
2548 < procedure TIBSQL.SetTransaction(Value: TIBTransaction);
2549 < begin
2550 <  FBase.Transaction := Value;
2551 < end;
2552 <
2553 < procedure TIBSQL.SQLChanging(Sender: TObject);
2554 < begin
2555 <  if Assigned(OnSQLChanging) then
2556 <    OnSQLChanging(Self);
2557 <  if FHandle <> nil then FreeHandle;
2558 < end;
2559 <
2560 < procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2561 < begin
2562 <  if (FOpen) then
2563 <    Close;
2564 < end;
2565 <
2566 < end.
1 > {************************************************************************}
2 > {                                                                        }
3 > {       Borland Delphi Visual Component Library                          }
4 > {       InterBase Express core components                                }
5 > {                                                                        }
6 > {       Copyright (c) 1998-2000 Inprise Corporation                      }
7 > {                                                                        }
8 > {    InterBase Express is based in part on the product                   }
9 > {    Free IB Components, written by Gregory H. Deatz for                 }
10 > {    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
11 > {    Free IB Components is used under license.                           }
12 > {                                                                        }
13 > {    The contents of this file are subject to the InterBase              }
14 > {    Public License Version 1.0 (the "License"); you may not             }
15 > {    use this file except in compliance with the License. You            }
16 > {    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 > {    Software distributed under the License is distributed on            }
18 > {    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19 > {    express or implied. See the License for the specific language       }
20 > {    governing rights and limitations under the License.                 }
21 > {    The Original Code was created by InterBase Software Corporation     }
22 > {       and its successors.                                              }
23 > {    Portions created by Inprise Corporation are Copyright (C) Inprise   }
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 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 > type
83 >  TIBSQL = class;
84 >  TIBXSQLDA = class;
85 >  
86 >  { TIBXSQLVAR }
87 >  TIBXSQLVAR = class(TObject)
88 >  private
89 >    FParent: TIBXSQLDA;
90 >    FSQL: TIBSQL;
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;
98 >    function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
99 >    function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
100 >    function GetAsCurrency: Currency;
101 >    function GetAsInt64: Int64;
102 >    function GetAsDateTime: TDateTime;
103 >    function GetAsDouble: Double;
104 >    function GetAsFloat: Float;
105 >    function GetAsLong: Long;
106 >    function GetAsPointer: Pointer;
107 >    function GetAsQuad: TISC_QUAD;
108 >    function GetAsShort: Short;
109 >    function GetAsString: String;
110 >    function GetAsVariant: Variant;
111 >    function GetAsXSQLVAR: PXSQLVAR;
112 >    function GetIsNull: Boolean;
113 >    function GetIsNullable: Boolean;
114 >    function GetSize: Integer;
115 >    function GetSQLType: Integer;
116 >    procedure SetAsCurrency(Value: Currency);
117 >    procedure SetAsInt64(Value: Int64);
118 >    procedure SetAsDate(Value: TDateTime);
119 >    procedure SetAsTime(Value: TDateTime);
120 >    procedure SetAsDateTime(Value: TDateTime);
121 >    procedure SetAsDouble(Value: Double);
122 >    procedure SetAsFloat(Value: Float);
123 >    procedure SetAsLong(Value: Long);
124 >    procedure SetAsPointer(Value: Pointer);
125 >    procedure SetAsQuad(Value: TISC_QUAD);
126 >    procedure SetAsShort(Value: Short);
127 >    procedure SetAsString(Value: String);
128 >    procedure SetAsVariant(Value: Variant);
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);
155 >    procedure SaveToStream(Stream: TStream);
156 >    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
157 >    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
158 >    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
159 >    property AsDouble: Double read GetAsDouble write SetAsDouble;
160 >    property AsFloat: Float read GetAsFloat write SetAsFloat;
161 >    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
162 >    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
163 >    property AsInteger: Integer read GetAsLong write SetAsLong;
164 >    property AsLong: Long read GetAsLong write SetAsLong;
165 >    property AsPointer: Pointer read GetAsPointer write SetAsPointer;
166 >    property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
167 >    property AsShort: Short read GetAsShort write SetAsShort;
168 >    property AsString: String read GetAsString write SetAsString;
169 >    property AsVariant: Variant read GetAsVariant write SetAsVariant;
170 >    property AsXSQLVAR: PXSQLVAR read GetAsXSQLVAR write SetAsXSQLVAR;
171 >    property Data: PXSQLVAR read FXSQLVAR write FXSQLVAR;
172 >    property IsNull: Boolean read GetIsNull write SetIsNull;
173 >    property IsNullable: Boolean read GetIsNullable write SetIsNullable;
174 >    property Index: Integer read FIndex;
175 >    property Modified: Boolean read FModified write FModified;
176 >    property Name: String read FName;
177 >    property Size: Integer read GetSize;
178 >    property SQLType: Integer read GetSQLType;
179 >    property Value: Variant read GetAsVariant write SetAsVariant;
180 >  end;
181 >
182 >  TIBXSQLVARArray = Array of TIBXSQLVAR;
183 >
184 >  TIBXSQLDAType = (daInput,daOutput);
185 >
186 >  { TIBXSQLDA }
187 >
188 >  TIBXSQLDA = class(TObject)
189 >  protected
190 >    FSQL: TIBSQL;
191 >    FCount: Integer;
192 >    FSize: Integer;
193 >    FInputSQLDA: boolean;
194 >    FXSQLDA: PXSQLDA;
195 >    FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
196 >    FUniqueRelationName: String;
197 >    function GetModified: Boolean;
198 >    function GetRecordSize: Integer;
199 >    function GetXSQLDA: PXSQLDA;
200 >    function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
201 >    function GetXSQLVARByName(Idx: String): TIBXSQLVAR;
202 >    procedure Initialize;
203 >    procedure SetCount(Value: Integer);
204 >  public
205 >    constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
206 >    destructor Destroy; override;
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;
212 >    property RecordSize: Integer read GetRecordSize;
213 >    property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
214 >    property UniqueRelationName: String read FUniqueRelationName;
215 >  end;
216 >
217 >  { TIBBatch }
218 >
219 >  TIBBatch = class(TObject)
220 >  protected
221 >    FFilename: String;
222 >    FColumns: TIBXSQLDA;
223 >    FParams: TIBXSQLDA;
224 >  public
225 >    procedure ReadyFile; virtual; abstract;
226 >    property Columns: TIBXSQLDA read FColumns;
227 >    property Filename: String read FFilename write FFilename;
228 >    property Params: TIBXSQLDA read FParams;
229 >  end;
230 >
231 >  TIBBatchInput = class(TIBBatch)
232 >  public
233 >    function ReadParameters: Boolean; virtual; abstract;
234 >  end;
235 >
236 >  TIBBatchOutput = class(TIBBatch)
237 >  public
238 >    function WriteColumns: Boolean; virtual; abstract;
239 >  end;
240 >
241 >
242 >  { TIBOutputDelimitedFile }
243 >  TIBOutputDelimitedFile = class(TIBBatchOutput)
244 >  protected
245 >  {$IFDEF UNIX}
246 >    FHandle: cint;
247 >  {$ELSE}
248 >    FHandle: THandle;
249 >  {$ENDIF}
250 >    FOutputTitles: Boolean;
251 >    FColDelimiter,
252 >    FRowDelimiter: string;
253 >  public
254 >    destructor Destroy; override;
255 >    procedure ReadyFile; override;
256 >    function WriteColumns: Boolean; override;
257 >    property ColDelimiter: string read FColDelimiter write FColDelimiter;
258 >    property OutputTitles: Boolean read FOutputTitles
259 >                                   write FOutputTitles;
260 >    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
261 >  end;
262 >
263 >  { TIBInputDelimitedFile }
264 >  TIBInputDelimitedFile = class(TIBBatchInput)
265 >  protected
266 >    FColDelimiter,
267 >    FRowDelimiter: string;
268 >    FEOF: Boolean;
269 >    FFile: TFileStream;
270 >    FLookAhead: Char;
271 >    FReadBlanksAsNull: Boolean;
272 >    FSkipTitles: Boolean;
273 >  public
274 >    destructor Destroy; override;
275 >    function GetColumn(var Col: string): Integer;
276 >    function ReadParameters: Boolean; override;
277 >    procedure ReadyFile; override;
278 >    property ColDelimiter: string read FColDelimiter write FColDelimiter;
279 >    property ReadBlanksAsNull: Boolean read FReadBlanksAsNull
280 >                                       write FReadBlanksAsNull;
281 >    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
282 >    property SkipTitles: Boolean read FSkipTitles write FSkipTitles;
283 >  end;
284 >
285 >  { TIBOutputRawFile }
286 >  TIBOutputRawFile = class(TIBBatchOutput)
287 >  protected
288 >  {$IFDEF UNIX}
289 >    FHandle: cint;
290 >  {$ELSE}
291 >    FHandle: THandle;
292 >  {$ENDIF}
293 >  public
294 >    destructor Destroy; override;
295 >    procedure ReadyFile; override;
296 >    function WriteColumns: Boolean; override;
297 >  end;
298 >
299 >  { TIBInputRawFile }
300 >  TIBInputRawFile = class(TIBBatchInput)
301 >  protected
302 >   {$IFDEF UNIX}
303 >    FHandle: cint;
304 >  {$ELSE}
305 >    FHandle: THandle;
306 >  {$ENDIF}
307 >  public
308 >    destructor Destroy; override;
309 >    function ReadParameters: Boolean; override;
310 >    procedure ReadyFile; override;
311 >  end;
312 >
313 >     { TIBSQL }
314 >  TIBSQLTypes = (SQLUnknown, SQLSelect, SQLInsert,
315 >                  SQLUpdate, SQLDelete, SQLDDL,
316 >                  SQLGetSegment, SQLPutSegment,
317 >                  SQLExecProcedure, SQLStartTransaction,
318 >                  SQLCommit, SQLRollback,
319 >                  SQLSelectForUpdate, SQLSetGenerator);
320 >
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? }
330 >    FEOF,                          { At EOF? }
331 >    FGoToFirstRecordOnExecute,     { Automatically position record on first record after executing }
332 >    FOpen,                         { Is a cursor open? }
333 >    FPrepared: Boolean;            { Has the query been prepared? }
334 >    FRecordCount: Integer;         { How many records have been read so far? }
335 >    FCursor: String;               { Cursor name...}
336 >    FHandle: TISC_STMT_HANDLE;     { Once prepared, this accesses the SQL Query }
337 >    FOnSQLChanging: TNotifyEvent;  { Call this when the SQL is changing }
338 >    FSQL: TStrings;                { SQL Query (by user) }
339 >    FParamCheck: Boolean;          { Check for parameters? (just like TQuery) }
340 >    FProcessedSQL: TStrings;       { SQL Query (pre-processed for param labels) }
341 >    FSQLParams,                    { Any parameters to the query }
342 >    FSQLRecord: TIBXSQLDA;         { The current record }
343 >    FSQLType: TIBSQLTypes;         { Select, update, delete, insert, create, alter, etc...}
344 >    FGenerateParamNames: Boolean;  { Auto generate param names ?}
345 >    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
346 >    function GetDatabase: TIBDatabase;
347 >    function GetDBHandle: PISC_DB_HANDLE;
348 >    function GetEOF: Boolean;
349 >    function GetFields(const Idx: Integer): TIBXSQLVAR;
350 >    function GetFieldIndex(FieldName: String): Integer;
351 >    function GetPlan: String;
352 >    function GetRecordCount: Integer;
353 >    function GetRowsAffected: Integer;
354 >    function GetSQLParams: TIBXSQLDA;
355 >    function GetTransaction: TIBTransaction;
356 >    function GetTRHandle: PISC_TR_HANDLE;
357 >    procedure PreprocessSQL;
358 >    procedure SetDatabase(Value: TIBDatabase);
359 >    procedure SetSQL(Value: TStrings);
360 >    procedure SetTransaction(Value: TIBTransaction);
361 >    procedure SQLChanging(Sender: TObject);
362 >    procedure BeforeTransactionEnd(Sender: TObject);
363 >  public
364 >    constructor Create(AOwner: TComponent); override;
365 >    destructor Destroy; override;
366 >    procedure BatchInput(InputObject: TIBBatchInput);
367 >    procedure BatchOutput(OutputObject: TIBBatchOutput);
368 >    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
369 >    procedure CheckClosed;           { raise error if query is not closed. }
370 >    procedure CheckOpen;             { raise error if query is not open.}
371 >    procedure CheckValidStatement;   { raise error if statement is invalid.}
372 >    procedure Close;
373 >    function Current: TIBXSQLDA;
374 >    procedure ExecQuery;
375 >    function FieldByName(FieldName: String): TIBXSQLVAR;
376 >    function ParamByName(ParamName: String): TIBXSQLVAR;
377 >    procedure FreeHandle;
378 >    function Next: TIBXSQLDA;
379 >    procedure Prepare;
380 >    function GetUniqueRelationName: String;
381 >    property Bof: Boolean read FBOF;
382 >    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
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;
390 >    property Prepared: Boolean read FPrepared;
391 >    property RecordCount: Integer read GetRecordCount;
392 >    property RowsAffected: Integer read GetRowsAffected;
393 >    property SQLType: TIBSQLTypes read FSQLType;
394 >    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
395 >    property Handle: TISC_STMT_HANDLE read FHandle;
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;
404 >    property ParamCheck: Boolean read FParamCheck write FParamCheck;
405 >    property SQL: TStrings read FSQL write SetSQL;
406 >    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
407 >    property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
408 >  end;
409 >
410 > implementation
411 >
412 > uses
413 >  IBIntf, IBBlob, Variants , IBSQLMonitor;
414 >
415 > { TIBXSQLVAR }
416 > constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
417 > begin
418 >  inherited Create;
419 >  FParent := Parent;
420 >  FSQL := Query;
421 > end;
422 >
423 > procedure TIBXSQLVAR.Assign(Source: TIBXSQLVAR);
424 > var
425 >  szBuff: PChar;
426 >  s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
427 >  bSourceBlob, bDestBlob: Boolean;
428 >  iSegs: Int64;
429 >  iMaxSeg: Int64;
430 >  iSize: Int64;
431 >  iBlobType: Short;
432 > begin
433 >  szBuff := nil;
434 >  bSourceBlob := True;
435 >  bDestBlob := True;
436 >  s_bhandle := nil;
437 >  d_bhandle := nil;
438 >  try
439 >    if (Source.IsNull) then
440 >    begin
441 >      IsNull := True;
442 >      exit;
443 >    end
444 >    else
445 >      if (FXSQLVAR^.sqltype and (not 1) = SQL_ARRAY) or
446 >         (Source.FXSQLVAR^.sqltype and (not 1) = SQL_ARRAY) then
447 >        exit; { arrays not supported }
448 >    if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
449 >       (Source.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
450 >    begin
451 >      AsXSQLVAR := Source.AsXSQLVAR;
452 >      exit;
453 >    end
454 >    else
455 >      if (Source.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
456 >      begin
457 >        szBuff := nil;
458 >        IBAlloc(szBuff, 0, Source.FXSQLVAR^.sqllen);
459 >        Move(Source.FXSQLVAR^.sqldata[0], szBuff[0], Source.FXSQLVAR^.sqllen);
460 >        bSourceBlob := False;
461 >        iSize := Source.FXSQLVAR^.sqllen;
462 >      end
463 >      else
464 >        if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
465 >          bDestBlob := False;
466 >
467 >    if bSourceBlob then
468 >    begin
469 >      { read the blob }
470 >      Source.FSQL.Call(isc_open_blob2(StatusVector, Source.FSQL.DBHandle,
471 >        Source.FSQL.TRHandle, @s_bhandle, PISC_QUAD(Source.FXSQLVAR.sqldata),
472 >        0, nil), True);
473 >      try
474 >        IBBlob.GetBlobInfo(@s_bhandle, iSegs, iMaxSeg, iSize,
475 >          iBlobType);
476 >        szBuff := nil;
477 >        IBAlloc(szBuff, 0, iSize);
478 >        IBBlob.ReadBlob(@s_bhandle, szBuff, iSize);
479 >      finally
480 >        Source.FSQL.Call(isc_close_blob(StatusVector, @s_bhandle), True);
481 >      end;
482 >    end;
483 >
484 >    if bDestBlob then
485 >    begin
486 >      { write the blob }
487 >      FSQL.Call(isc_create_blob2(StatusVector, FSQL.DBHandle,
488 >        FSQL.TRHandle, @d_bhandle, PISC_QUAD(FXSQLVAR.sqldata),
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;
496 >    end
497 >    else
498 >    begin
499 >      { just copy the buffer }
500 >      FXSQLVAR.sqltype := SQL_TEXT;
501 >      FXSQLVAR.sqllen := iSize;
502 >      IBAlloc(FXSQLVAR.sqldata, iSize, iSize);
503 >      Move(szBuff[0], FXSQLVAR^.sqldata[0], iSize);
504 >    end;
505 >  finally
506 >    FreeMem(szBuff);
507 >  end;
508 > end;
509 >
510 > function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
511 > var
512 >  Scaling : Int64;
513 >  i: Integer;
514 >  Val: Double;
515 > begin
516 >  Scaling := 1; Val := Value;
517 >  if Scale > 0 then
518 >  begin
519 >    for i := 1 to Scale do
520 >      Scaling := Scaling * 10;
521 >    result := Val * Scaling;
522 >  end
523 >  else
524 >    if Scale < 0 then
525 >    begin
526 >      for i := -1 downto Scale do
527 >        Scaling := Scaling * 10;
528 >      result := Val / Scaling;
529 >    end
530 >    else
531 >      result := Val;
532 > end;
533 >
534 > function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
535 > var
536 >  Scaling : Int64;
537 >  i: Integer;
538 >  Val: Int64;
539 > begin
540 >  Scaling := 1; Val := Value;
541 >  if Scale > 0 then begin
542 >    for i := 1 to Scale do Scaling := Scaling * 10;
543 >    result := Val * Scaling;
544 >  end else if Scale < 0 then begin
545 >    for i := -1 downto Scale do Scaling := Scaling * 10;
546 >    result := Val div Scaling;
547 >  end else
548 >    result := Val;
549 > end;
550 >
551 > function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
552 > var
553 >  Scaling : Int64;
554 >  i : Integer;
555 >  FractionText, PadText, CurrText: string;
556 > begin
557 >  Result := 0;
558 >  Scaling := 1;
559 >  if Scale > 0 then
560 >  begin
561 >    for i := 1 to Scale do
562 >      Scaling := Scaling * 10;
563 >    result := Value * Scaling;
564 >  end
565 >  else
566 >    if Scale < 0 then
567 >    begin
568 >      for i := -1 downto Scale do
569 >        Scaling := Scaling * 10;
570 >      FractionText := IntToStr(abs(Value mod Scaling));
571 >      for i := Length(FractionText) to -Scale -1 do
572 >        PadText := '0' + PadText;
573 >      if Value < 0 then
574 >        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
575 >      else
576 >        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
577 >      try
578 >        result := StrToCurr(CurrText);
579 >      except
580 >        on E: Exception do
581 >          IBError(ibxeInvalidDataConversion, [nil]);
582 >      end;
583 >    end
584 >    else
585 >      result := Value;
586 > end;
587 >
588 > function TIBXSQLVAR.GetAsCurrency: Currency;
589 > begin
590 >  result := 0;
591 >  if FSQL.Database.SQLDialect < 3 then
592 >    result := GetAsDouble
593 >  else begin
594 >    if not IsNull then
595 >      case FXSQLVAR^.sqltype and (not 1) of
596 >        SQL_TEXT, SQL_VARYING: begin
597 >          try
598 >            result := StrtoCurr(AsString);
599 >          except
600 >            on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
601 >          end;
602 >        end;
603 >        SQL_SHORT:
604 >          result := AdjustScaleToCurrency(Int64(PShort(FXSQLVAR^.sqldata)^),
605 >                                      FXSQLVAR^.sqlscale);
606 >        SQL_LONG:
607 >          result := AdjustScaleToCurrency(Int64(PLong(FXSQLVAR^.sqldata)^),
608 >                                      FXSQLVAR^.sqlscale);
609 >        SQL_INT64:
610 >          result := AdjustScaleToCurrency(PInt64(FXSQLVAR^.sqldata)^,
611 >                                      FXSQLVAR^.sqlscale);
612 >        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
613 >          result := Trunc(AsDouble);
614 >        else
615 >          IBError(ibxeInvalidDataConversion, [nil]);
616 >      end;
617 >    end;
618 > end;
619 >
620 > function TIBXSQLVAR.GetAsInt64: Int64;
621 > begin
622 >  result := 0;
623 >  if not IsNull then
624 >    case FXSQLVAR^.sqltype and (not 1) of
625 >      SQL_TEXT, SQL_VARYING: begin
626 >        try
627 >          result := StrToInt64(AsString);
628 >        except
629 >          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
630 >        end;
631 >      end;
632 >      SQL_SHORT:
633 >        result := AdjustScaleToInt64(Int64(PShort(FXSQLVAR^.sqldata)^),
634 >                                    FXSQLVAR^.sqlscale);
635 >      SQL_LONG:
636 >        result := AdjustScaleToInt64(Int64(PLong(FXSQLVAR^.sqldata)^),
637 >                                    FXSQLVAR^.sqlscale);
638 >      SQL_INT64:
639 >        result := AdjustScaleToInt64(PInt64(FXSQLVAR^.sqldata)^,
640 >                                    FXSQLVAR^.sqlscale);
641 >      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
642 >        result := Trunc(AsDouble);
643 >      else
644 >        IBError(ibxeInvalidDataConversion, [nil]);
645 >    end;
646 > end;
647 >
648 > function TIBXSQLVAR.GetAsDateTime: TDateTime;
649 > var
650 >  tm_date: TCTimeStructure;
651 >  msecs: word;
652 > begin
653 >  result := 0;
654 >  if not IsNull then
655 >    case FXSQLVAR^.sqltype and (not 1) of
656 >      SQL_TEXT, SQL_VARYING: begin
657 >        try
658 >          result := StrToDate(AsString);
659 >        except
660 >          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
661 >        end;
662 >      end;
663 >      SQL_TYPE_DATE: begin
664 >        isc_decode_sql_date(PISC_DATE(FXSQLVAR^.sqldata), @tm_date);
665 >        try
666 >          result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
667 >                               Word(tm_date.tm_mday));
668 >        except
669 >          on E: EConvertError do begin
670 >            IBError(ibxeInvalidDataConversion, [nil]);
671 >          end;
672 >        end;
673 >      end;
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), msecs)
680 >        except
681 >          on E: EConvertError do begin
682 >            IBError(ibxeInvalidDataConversion, [nil]);
683 >          end;
684 >        end;
685 >      end;
686 >      SQL_TIMESTAMP: begin
687 >        isc_decode_date(PISC_QUAD(FXSQLVAR^.sqldata), @tm_date);
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), msecs)
695 >          else
696 >            result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
697 >                                          Word(tm_date.tm_sec), msecs)
698 >        except
699 >          on E: EConvertError do begin
700 >            IBError(ibxeInvalidDataConversion, [nil]);
701 >          end;
702 >        end;
703 >      end;
704 >      else
705 >        IBError(ibxeInvalidDataConversion, [nil]);
706 >    end;
707 > end;
708 >
709 > function TIBXSQLVAR.GetAsDouble: Double;
710 > begin
711 >  result := 0;
712 >  if not IsNull then begin
713 >    case FXSQLVAR^.sqltype and (not 1) of
714 >      SQL_TEXT, SQL_VARYING: begin
715 >        try
716 >          result := StrToFloat(AsString);
717 >        except
718 >          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
719 >        end;
720 >      end;
721 >      SQL_SHORT:
722 >        result := AdjustScale(Int64(PShort(FXSQLVAR^.sqldata)^),
723 >                              FXSQLVAR^.sqlscale);
724 >      SQL_LONG:
725 >        result := AdjustScale(Int64(PLong(FXSQLVAR^.sqldata)^),
726 >                              FXSQLVAR^.sqlscale);
727 >      SQL_INT64:
728 >        result := AdjustScale(PInt64(FXSQLVAR^.sqldata)^, FXSQLVAR^.sqlscale);
729 >      SQL_FLOAT:
730 >        result := PFloat(FXSQLVAR^.sqldata)^;
731 >      SQL_DOUBLE, SQL_D_FLOAT:
732 >        result := PDouble(FXSQLVAR^.sqldata)^;
733 >      else
734 >        IBError(ibxeInvalidDataConversion, [nil]);
735 >    end;
736 >    if  FXSQLVAR^.sqlscale <> 0 then
737 >      result :=
738 >        StrToFloat(FloatToStrF(result, fffixed, 15,
739 >                  Abs(FXSQLVAR^.sqlscale) ));
740 >  end;
741 > end;
742 >
743 > function TIBXSQLVAR.GetAsFloat: Float;
744 > begin
745 >  result := 0;
746 >  try
747 >    result := AsDouble;
748 >  except
749 >    on E: EOverflow do
750 >      IBError(ibxeInvalidDataConversion, [nil]);
751 >  end;
752 > end;
753 >
754 > function TIBXSQLVAR.GetAsLong: Long;
755 > begin
756 >  result := 0;
757 >  if not IsNull then
758 >    case FXSQLVAR^.sqltype and (not 1) of
759 >      SQL_TEXT, SQL_VARYING: begin
760 >        try
761 >          result := StrToInt(AsString);
762 >        except
763 >          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
764 >        end;
765 >      end;
766 >      SQL_SHORT:
767 >        result := Trunc(AdjustScale(Int64(PShort(FXSQLVAR^.sqldata)^),
768 >                                    FXSQLVAR^.sqlscale));
769 >      SQL_LONG:
770 >        result := Trunc(AdjustScale(Int64(PLong(FXSQLVAR^.sqldata)^),
771 >                                    FXSQLVAR^.sqlscale));
772 >      SQL_INT64:
773 >        result := Trunc(AdjustScale(PInt64(FXSQLVAR^.sqldata)^, FXSQLVAR^.sqlscale));
774 >      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
775 >        result := Trunc(AsDouble);
776 >      else
777 >        IBError(ibxeInvalidDataConversion, [nil]);
778 >    end;
779 > end;
780 >
781 > function TIBXSQLVAR.GetAsPointer: Pointer;
782 > begin
783 >  if not IsNull then
784 >    result := FXSQLVAR^.sqldata
785 >  else
786 >    result := nil;
787 > end;
788 >
789 > function TIBXSQLVAR.GetAsQuad: TISC_QUAD;
790 > begin
791 >  result.gds_quad_high := 0;
792 >  result.gds_quad_low := 0;
793 >  if not IsNull then
794 >    case FXSQLVAR^.sqltype and (not 1) of
795 >      SQL_BLOB, SQL_ARRAY, SQL_QUAD:
796 >        result := PISC_QUAD(FXSQLVAR^.sqldata)^;
797 >      else
798 >        IBError(ibxeInvalidDataConversion, [nil]);
799 >    end;
800 > end;
801 >
802 > function TIBXSQLVAR.GetAsShort: Short;
803 > begin
804 >  result := 0;
805 >  try
806 >    result := AsLong;
807 >  except
808 >    on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
809 >  end;
810 > end;
811 >
812 >
813 > function TIBXSQLVAR.GetAsString: String;
814 > var
815 >  sz: PChar;
816 >  str_len: Integer;
817 >  ss: TStringStream;
818 > begin
819 >  result := '';
820 >  { Check null, if so return a default string }
821 >  if not IsNull then
822 >    case FXSQLVar^.sqltype and (not 1) of
823 >      SQL_ARRAY:
824 >        result := '(Array)'; {do not localize}
825 >      SQL_BLOB: begin
826 >        ss := TStringStream.Create('');
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;
836 >        if (FXSQLVar^.sqltype and (not 1) = SQL_TEXT) then
837 >          str_len := FXSQLVar^.sqllen
838 >        else begin
839 >          str_len := isc_vax_integer(FXSQLVar^.sqldata, 2);
840 >          Inc(sz, 2);
841 >        end;
842 >        SetString(result, sz, str_len);
843 >        if ((FXSQLVar^.sqltype and (not 1)) = SQL_TEXT) then
844 >          result := TrimRight(result);
845 >      end;
846 >      SQL_TYPE_DATE:
847 >        case FSQL.Database.SQLDialect of
848 >          1 : result := DateTimeToStr(AsDateTime);
849 >          3 : result := DateToStr(AsDateTime);
850 >        end;
851 >      SQL_TYPE_TIME :
852 >        result := TimeToStr(AsDateTime);
853 >      SQL_TIMESTAMP:
854 >        result := DateTimeToStr(AsDateTime);
855 >      SQL_SHORT, SQL_LONG:
856 >        if FXSQLVAR^.sqlscale = 0 then
857 >          result := IntToStr(AsLong)
858 >        else if FXSQLVAR^.sqlscale >= (-4) then
859 >          result := CurrToStr(AsCurrency)
860 >        else
861 >          result := FloatToStr(AsDouble);
862 >      SQL_INT64:
863 >        if FXSQLVAR^.sqlscale = 0 then
864 >          result := IntToStr(AsInt64)
865 >        else if FXSQLVAR^.sqlscale >= (-4) then
866 >          result := CurrToStr(AsCurrency)
867 >        else
868 >          result := FloatToStr(AsDouble);
869 >      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
870 >        result := FloatToStr(AsDouble);
871 >      else
872 >        IBError(ibxeInvalidDataConversion, [nil]);
873 >    end;
874 > end;
875 >
876 > function TIBXSQLVAR.GetAsVariant: Variant;
877 > begin
878 >  if IsNull then
879 >    result := NULL
880 >  { Check null, if so return a default string }
881 >  else case FXSQLVar^.sqltype and (not 1) of
882 >      SQL_ARRAY:
883 >        result := '(Array)'; {do not localize}
884 >      SQL_BLOB:
885 >        result := '(Blob)'; {do not localize}
886 >      SQL_TEXT, SQL_VARYING:
887 >        result := AsString;
888 >      SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
889 >        result := AsDateTime;
890 >      SQL_SHORT, SQL_LONG:
891 >        if FXSQLVAR^.sqlscale = 0 then
892 >          result := AsLong
893 >        else if FXSQLVAR^.sqlscale >= (-4) then
894 >          result := AsCurrency
895 >        else
896 >          result := AsDouble;
897 >      SQL_INT64:
898 >        if FXSQLVAR^.sqlscale = 0 then
899 >          IBError(ibxeInvalidDataConversion, [nil])
900 >        else if FXSQLVAR^.sqlscale >= (-4) then
901 >          result := AsCurrency
902 >        else
903 >          result := AsDouble;
904 >      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
905 >        result := AsDouble;
906 >      else
907 >        IBError(ibxeInvalidDataConversion, [nil]);
908 >    end;
909 > end;
910 >
911 > function TIBXSQLVAR.GetAsXSQLVAR: PXSQLVAR;
912 > begin
913 >  result := FXSQLVAR;
914 > end;
915 >
916 > function TIBXSQLVAR.GetIsNull: Boolean;
917 > begin
918 >  result := IsNullable and (FXSQLVAR^.sqlind^ = -1);
919 > end;
920 >
921 > function TIBXSQLVAR.GetIsNullable: Boolean;
922 > begin
923 >  result := (FXSQLVAR^.sqltype and 1 = 1);
924 > end;
925 >
926 > procedure TIBXSQLVAR.LoadFromFile(const FileName: String);
927 > var
928 >  fs: TFileStream;
929 > begin
930 >  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
931 >  try
932 >    LoadFromStream(fs);
933 >  finally
934 >    fs.Free;
935 >  end;
936 > end;
937 >
938 > procedure TIBXSQLVAR.LoadFromStream(Stream: TStream);
939 > var
940 >  bs: TIBBlobStream;
941 > begin
942 >  bs := TIBBlobStream.Create;
943 >  try
944 >    bs.Mode := bmWrite;
945 >    bs.Database := FSQL.Database;
946 >    bs.Transaction := FSQL.Transaction;
947 >    Stream.Seek(0, soFromBeginning);
948 >    bs.LoadFromStream(Stream);
949 >    bs.Finalize;
950 >    AsQuad := bs.BlobID;
951 >  finally
952 >    bs.Free;
953 >  end;
954 > end;
955 >
956 > procedure TIBXSQLVAR.SaveToFile(const FileName: String);
957 > var
958 >  fs: TFileStream;
959 > begin
960 >  fs := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
961 >  try
962 >    SaveToStream(fs);
963 >  finally
964 >    fs.Free;
965 >  end;
966 > end;
967 >
968 > procedure TIBXSQLVAR.SaveToStream(Stream: TStream);
969 > var
970 >  bs: TIBBlobStream;
971 > begin
972 >  bs := TIBBlobStream.Create;
973 >  try
974 >    bs.Mode := bmRead;
975 >    bs.Database := FSQL.Database;
976 >    bs.Transaction := FSQL.Transaction;
977 >    bs.BlobID := AsQuad;
978 >    bs.SaveToStream(Stream);
979 >  finally
980 >    bs.Free;
981 >  end;
982 > end;
983 >
984 > function TIBXSQLVAR.GetSize: Integer;
985 > begin
986 >  result := FXSQLVAR^.sqllen;
987 > end;
988 >
989 > function TIBXSQLVAR.GetSQLType: Integer;
990 > 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
1008 >  i: Integer;
1009 > begin
1010 >  if FSQL.Database.SQLDialect < 3 then
1011 >    AsDouble := Value
1012 >  else
1013 >  begin
1014 >
1015 >    if FUniqueName then
1016 >       xSetAsCurrency(Value)
1017 >    else
1018 >    for i := 0 to FParent.FCount - 1 do
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 > 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 >
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;
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 >
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;
1120 > begin
1121 >  if FSQL.Database.SQLDialect < 3 then
1122 >  begin
1123 >    AsDateTime := Value;
1124 >    exit;
1125 >  end;
1126 >
1127 >  if FUniqueName then
1128 >     xSetAsTime(Value)
1129 >  else
1130 >  for i := 0 to FParent.FCount - 1 do
1131 >    if FParent[i].FName = FName then
1132 >       FParent[i].xSetAsTime(Value);
1133 > end;
1134 >
1135 > procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1136 > var
1137 >  tm_date: TCTimeStructure;
1138 >  Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
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[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 > 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 >
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 > 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 >
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;
1240 > begin
1241 >  if FUniqueName then
1242 >     xSetAsLong(Value)
1243 >  else
1244 >  for i := 0 to FParent.FCount - 1 do
1245 >    if FParent[i].FName = FName then
1246 >       FParent[i].xSetAsLong(Value);
1247 > end;
1248 >
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 >    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 > 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 >
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;
1314 > begin
1315 >  if FUniqueName then
1316 >     xSetAsShort(Value)
1317 >  else
1318 >  for i := 0 to FParent.FCount - 1 do
1319 >    if FParent[i].FName = FName then
1320 >       FParent[i].xSetAsShort(Value);
1321 > end;
1322 >
1323 > procedure TIBXSQLVAR.xSetAsString(Value: String);
1324 > var
1325 >   stype: Integer;
1326 >   ss: TStringStream;
1327 >
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 >      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
1352 >  else begin
1353 >    if (stype = SQL_BLOB) then
1354 >    begin
1355 >      ss := TStringStream.Create(Value);
1356 >      try
1357 >        LoadFromStream(ss);
1358 >      finally
1359 >        ss.Free;
1360 >      end;
1361 >    end
1362 >    else if Value = '' then
1363 >      IsNull := True
1364 >    else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1365 >      (stype = SQL_TYPE_TIME) then
1366 >      xSetAsDateTime(StrToDateTime(Value))
1367 >    else
1368 >      SetStringValue;
1369 >  end;
1370 > end;
1371 >
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,
1392 >      varWord, varShortInt:
1393 >      AsLong := Value;
1394 >    varInt64:
1395 >      AsInt64 := Value;
1396 >    varSingle, varDouble:
1397 >      AsDouble := Value;
1398 >    varCurrency:
1399 >      AsCurrency := Value;
1400 >    varBoolean:
1401 >      if Value then
1402 >        AsLong := ISC_TRUE
1403 >      else
1404 >        AsLong := ISC_FALSE;
1405 >    varDate:
1406 >      AsDateTime := Value;
1407 >    varOleStr, varString:
1408 >      AsString := Value;
1409 >    varArray:
1410 >      IBError(ibxeNotSupported, [nil]);
1411 >    varByRef, varDispatch, varError, varUnknown, varVariant:
1412 >      IBError(ibxeNotPermitted, [nil]);
1413 >  end;
1414 > end;
1415 >
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
1430 >  sqlind: PShort;
1431 >  sqldata: PChar;
1432 >  local_sqllen: Integer;
1433 > begin
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.SetAsXSQLVAR(Value: PXSQLVAR);
1459 > var
1460 >  i: Integer;
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 >
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 >      if Assigned(FXSQLVAR^.sqlind) then
1485 >        FXSQLVAR^.sqlind^ := 0;
1486 >      FModified := True;
1487 >    end;
1488 > end;
1489 >
1490 > procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1491 > var
1492 >  i: Integer;
1493 > begin
1494 >  if FUniqueName then
1495 >     xSetIsNull(Value)
1496 >  else
1497 >  for i := 0 to FParent.FCount - 1 do
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 >      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; sqldaType: TIBXSQLDAType);
1539 > begin
1540 >  inherited Create;
1541 >  FSQL := Query;
1542 >  FSize := 0;
1543 >  FUniqueRelationName := '';
1544 >  FInputSQLDA := sqldaType = daInput;
1545 > end;
1546 >
1547 > destructor TIBXSQLDA.Destroy;
1548 > var
1549 >  i: Integer;
1550 > begin
1551 >  if FXSQLDA <> nil then
1552 >  begin
1553 >    for i := 0 to FSize - 1 do
1554 >    begin
1555 >      FreeMem(FXSQLVARs[i].FXSQLVAR^.sqldata);
1556 >      FreeMem(FXSQLVARs[i].FXSQLVAR^.sqlind);
1557 >      FXSQLVARs[i].Free ;
1558 >    end;
1559 >    FreeMem(FXSQLDA);
1560 >    FXSQLDA := nil;
1561 >    FXSQLVARs := nil;
1562 >  end;
1563 >  inherited Destroy;
1564 > end;
1565 >
1566 >    procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1567 >    UniqueName: boolean);
1568 > var
1569 >  fn: string;
1570 > begin
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;
1581 > var
1582 >  i: Integer;
1583 > begin
1584 >  result := False;
1585 >  for i := 0 to FCount - 1 do
1586 >    if FXSQLVARs[i].Modified then
1587 >    begin
1588 >      result := True;
1589 >      exit;
1590 >    end;
1591 > end;
1592 >
1593 > function TIBXSQLDA.GetRecordSize: Integer;
1594 > begin
1595 >  result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
1596 > end;
1597 >
1598 > function TIBXSQLDA.GetXSQLDA: PXSQLDA;
1599 > begin
1600 >  result := FXSQLDA;
1601 > end;
1602 >
1603 > function TIBXSQLDA.GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
1604 > begin
1605 >  if (Idx < 0) or (Idx >= FCount) then
1606 >    IBError(ibxeXSQLDAIndexOutOfRange, [nil]);
1607 >  result := FXSQLVARs[Idx]
1608 > end;
1609 >
1610 > function TIBXSQLDA.ByName(Idx: String): TIBXSQLVAR;
1611 > begin
1612 >  result := GetXSQLVARByName(Idx);
1613 >  if result = nil then
1614 >    IBError(ibxeFieldNotFound, [Idx]);
1615 > end;
1616 >
1617 > function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1618 > var
1619 >  s: String;
1620 >  i: Integer;
1621 > begin
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;
1657 >  st: String;
1658 >  bUnique: Boolean;
1659 >  sBaseName: string;
1660 > begin
1661 >  bUnique := True;
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
1674 >            FUniqueRelationName := strpas(relname)
1675 >          else
1676 >            if strpas(relname) <> FUniqueRelationName then
1677 >            begin
1678 >              FUniqueRelationName := '';
1679 >              bUnique := False;
1680 >            end;
1681 >        end;
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 := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1690 >          if st = '' then
1691 >          begin
1692 >            sBaseName := 'F_'; {do not localize}
1693 >            aliasname_length := 2;
1694 >            j := 1; j_len := 1;
1695 >            st := sBaseName + IntToStr(j);
1696 >          end
1697 >          else
1698 >          begin
1699 >            j := 0; j_len := 0;
1700 >            sBaseName := st;
1701 >          end;
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);
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 >
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,
1725 >          SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1726 >            if (sqllen = 0) then
1727 >              { Make sure you get a valid pointer anyway
1728 >               select '' from foo }
1729 >              IBAlloc(sqldata, 0, 1)
1730 >            else
1731 >              IBAlloc(sqldata, 0, sqllen)
1732 >          end;
1733 >          SQL_VARYING: begin
1734 >            IBAlloc(sqldata, 0, sqllen + 2);
1735 >          end;
1736 >          else
1737 >            IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
1738 >        end;
1739 >        if (sqltype and 1 = 1) then
1740 >          IBAlloc(sqlind, 0, SizeOf(Short))
1741 >        else
1742 >          if (sqlind <> nil) then
1743 >            ReallocMem(sqlind, 0);
1744 >      end;
1745 >    end;
1746 >  end;
1747 > end;
1748 >
1749 > procedure TIBXSQLDA.SetCount(Value: Integer);
1750 > var
1751 >  i, OldSize: Integer;
1752 >  p : PXSQLVAR;
1753 > begin
1754 >  FCount := Value;
1755 >  if FCount = 0 then
1756 >    FUniqueRelationName := ''
1757 >  else
1758 >  begin
1759 >    if FSize > 0 then
1760 >      OldSize := XSQLDA_LENGTH(FSize)
1761 >    else
1762 >      OldSize := 0;
1763 >    if FCount > FSize then
1764 >    begin
1765 >      IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(FCount));
1766 >      SetLength(FXSQLVARs, FCount);
1767 >      FXSQLDA^.version := SQLDA_VERSION1;
1768 >      p := @FXSQLDA^.sqlvar[0];
1769 >      for i := 0 to FCount - 1 do
1770 >      begin
1771 >        if i >= FSize then
1772 >          FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1773 >        FXSQLVARs[i].FXSQLVAR := p;
1774 >        p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1775 >      end;
1776 >      FSize := FCount;
1777 >    end;
1778 >    if FSize > 0 then
1779 >    begin
1780 >      FXSQLDA^.sqln := Value;
1781 >      FXSQLDA^.sqld := Value;
1782 >    end;
1783 >  end;
1784 > end;
1785 >
1786 > { TIBOutputDelimitedFile }
1787 >
1788 > destructor TIBOutputDelimitedFile.Destroy;
1789 > begin
1790 > {$IFDEF UNIX}
1791 >  if FHandle <> -1 then
1792 >     fpclose(FHandle);
1793 > {$ELSE}
1794 >  if FHandle <> 0 then
1795 >  begin
1796 >    FlushFileBuffers(FHandle);
1797 >    CloseHandle(FHandle);
1798 >  end;
1799 > {$ENDIF}
1800 >  inherited Destroy;
1801 > end;
1802 >
1803 > procedure TIBOutputDelimitedFile.ReadyFile;
1804 > var
1805 >  i: Integer;
1806 >  {$IFDEF UNIX}
1807 >  BytesWritten: cint;
1808 >  {$ELSE}
1809 >  BytesWritten: DWORD;
1810 >  {$ENDIF}
1811 >  st: string;
1812 > begin
1813 >  if FColDelimiter = '' then
1814 >    FColDelimiter := TAB;
1815 >  if FRowDelimiter = '' then
1816 >    FRowDelimiter := CRLF;
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,
1821 >                        FILE_ATTRIBUTE_NORMAL, 0);
1822 >  if FHandle = INVALID_HANDLE_VALUE then
1823 >    FHandle := 0;
1824 >  {$ENDIF}
1825 >  if FOutputTitles then
1826 >  begin
1827 >    for i := 0 to Columns.Count - 1 do
1828 >      if i = 0 then
1829 >        st := strpas(Columns[i].Data^.aliasname)
1830 >      else
1831 >        st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1832 >    st := st + FRowDelimiter;
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, st[1], Length(st), BytesWritten, nil);
1840 >    {$ENDIF}
1841 >  end;
1842 > end;
1843 >
1844 > function TIBOutputDelimitedFile.WriteColumns: Boolean;
1845 > var
1846 >  i: Integer;
1847 >  {$IFDEF UNIX}
1848 >  BytesWritten: cint;
1849 >  {$ELSE}
1850 >  BytesWritten: DWORD;
1851 >  {$ENDIF}
1852 >  st: string;
1853 > begin
1854 >  result := False;
1855 >  {$IFDEF UNIX}
1856 >  if FHandle <> -1 then
1857 >  {$ELSE}
1858 >  if FHandle <> 0 then
1859 >  {$ENDIF}
1860 >  begin
1861 >    st := '';
1862 >    for i := 0 to Columns.Count - 1 do
1863 >    begin
1864 >      if i > 0 then
1865 >        st := st + FColDelimiter;
1866 >      st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1867 >    end;
1868 >    st := st + FRowDelimiter;
1869 >  {$IFDEF UNIX}
1870 >    BytesWritten := FpWrite(FHandle,st[1],Length(st));
1871 >  {$ELSE}
1872 >    WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1873 >  {$ENDIF}
1874 >    if BytesWritten = DWORD(Length(st)) then
1875 >      result := True;
1876 >  end
1877 > end;
1878 >
1879 > { TIBInputDelimitedFile }
1880 >
1881 > destructor TIBInputDelimitedFile.Destroy;
1882 > begin
1883 >  FFile.Free;
1884 >  inherited Destroy;
1885 > end;
1886 >
1887 > function TIBInputDelimitedFile.GetColumn(var Col: string): Integer;
1888 > var
1889 >  c: Char;
1890 >  BytesRead: Integer;
1891 >
1892 >  procedure ReadInput;
1893 >  begin
1894 >    if FLookAhead <> NULL_TERMINATOR then
1895 >    begin
1896 >      c := FLookAhead;
1897 >      BytesRead := 1;
1898 >      FLookAhead := NULL_TERMINATOR;
1899 >    end else
1900 >      BytesRead := FFile.Read(c, 1);
1901 >  end;
1902 >
1903 >  procedure CheckCRLF(Delimiter: string);
1904 >  begin
1905 >    if (c = CR) and (Pos(LF, Delimiter) > 0) then {mbcs ok}
1906 >    begin
1907 >      BytesRead := FFile.Read(c, 1);
1908 >      if (BytesRead = 1) and (c <> #10) then
1909 >        FLookAhead := c
1910 >    end;
1911 >  end;
1912 >
1913 > begin
1914 >  Col := '';
1915 >  result := 0;
1916 >  ReadInput;
1917 >  while BytesRead <> 0 do begin
1918 >    if Pos(c, FColDelimiter) > 0 then {mbcs ok}
1919 >    begin
1920 >      CheckCRLF(FColDelimiter);
1921 >      result := 1;
1922 >      break;
1923 >    end else if Pos(c, FRowDelimiter) > 0 then {mbcs ok}
1924 >    begin
1925 >      CheckCRLF(FRowDelimiter);
1926 >      result := 2;
1927 >      break;
1928 >    end else
1929 >      Col := Col + c;
1930 >    ReadInput;
1931 >  end;
1932 > end;
1933 >
1934 > function TIBInputDelimitedFile.ReadParameters: Boolean;
1935 > var
1936 >  i, curcol: Integer;
1937 >  Col: string;
1938 > begin
1939 >  result := False;
1940 >  if not FEOF then begin
1941 >    curcol := 0;
1942 >    repeat
1943 >      i := GetColumn(Col);
1944 >      if (i = 0) then
1945 >        FEOF := True;
1946 >      if (curcol < Params.Count) then
1947 >      begin
1948 >        try
1949 >          if (Col = '') and
1950 >             (ReadBlanksAsNull) then
1951 >            Params[curcol].IsNull := True
1952 >          else
1953 >            Params[curcol].AsString := Col;
1954 >          Inc(curcol);
1955 >        except
1956 >          on E: Exception do begin
1957 >            if not (FEOF and (curcol = Params.Count)) then
1958 >              raise;
1959 >          end;
1960 >        end;
1961 >      end;
1962 >    until (FEOF) or (i = 2);
1963 >    result := ((FEOF) and (curcol = Params.Count)) or
1964 >              (not FEOF);
1965 >  end;
1966 > end;
1967 >
1968 > procedure TIBInputDelimitedFile.ReadyFile;
1969 > begin
1970 >  if FColDelimiter = '' then
1971 >    FColDelimiter := TAB;
1972 >  if FRowDelimiter = '' then
1973 >    FRowDelimiter := CRLF;
1974 >  FLookAhead := NULL_TERMINATOR;
1975 >  FEOF := False;
1976 >  if FFile <> nil then
1977 >    FFile.Free;
1978 >  FFile := TFileStream.Create(FFilename, fmOpenRead or fmShareDenyWrite);
1979 >  if FSkipTitles then
1980 >    ReadParameters;
1981 > end;
1982 >
1983 > { TIBOutputRawFile }
1984 > destructor TIBOutputRawFile.Destroy;
1985 > begin
1986 > {$IFDEF UNIX}
1987 >  if FHandle <> -1 then
1988 >     fpclose(FHandle);
1989 > {$ELSE}
1990 >  if FHandle <> 0 then
1991 >  begin
1992 >    FlushFileBuffers(FHandle);
1993 >    CloseHandle(FHandle);
1994 >  end;
1995 > {$ENDIF}
1996 >  inherited Destroy;
1997 > end;
1998 >
1999 > procedure TIBOutputRawFile.ReadyFile;
2000 > begin
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,
2005 >                        FILE_ATTRIBUTE_NORMAL, 0);
2006 >  if FHandle = INVALID_HANDLE_VALUE then
2007 >    FHandle := 0;
2008 >  {$ENDIF}
2009 > end;
2010 >
2011 > function TIBOutputRawFile.WriteColumns: Boolean;
2012 > var
2013 >  i: Integer;
2014 >  BytesWritten: DWord;
2015 > begin
2016 >  result := False;
2017 >  if FHandle <> 0 then
2018 >  begin
2019 >    for i := 0 to Columns.Count - 1 do
2020 >    begin
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,
2025 >                BytesWritten, nil);
2026 >      {$ENDIF}
2027 >      if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
2028 >        exit;
2029 >    end;
2030 >    result := True;
2031 >  end;
2032 > end;
2033 >
2034 > { TIBInputRawFile }
2035 > destructor TIBInputRawFile.Destroy;
2036 > begin
2037 > {$IFDEF UNIX}
2038 >  if FHandle <> -1 then
2039 >     fpclose(FHandle);
2040 > {$ELSE}
2041 >  if FHandle <> 0 then
2042 >    CloseHandle(FHandle);
2043 > {$ENDIF}
2044 >  inherited Destroy;
2045 > end;
2046 >
2047 > function TIBInputRawFile.ReadParameters: Boolean;
2048 > var
2049 >  i: Integer;
2050 >  BytesRead: DWord;
2051 > begin
2052 >  result := False;
2053 > {$IFDEF UNIX}
2054 >  if FHandle <> -1 then
2055 > {$ELSE}
2056 >  if FHandle <> 0 then
2057 > {$ENDIF}
2058 >  begin
2059 >    for i := 0 to Params.Count - 1 do
2060 >    begin
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,
2065 >               BytesRead, nil);
2066 >      {$ENDIF}
2067 >      if BytesRead <> DWORD(Params[i].Data^.sqllen) then
2068 >        exit;
2069 >    end;
2070 >    result := True;
2071 >  end;
2072 > end;
2073 >
2074 > procedure TIBInputRawFile.ReadyFile;
2075 > begin
2076 > {$IFDEF UNIX}
2077 >  if FHandle <> -1 then
2078 >     fpclose(FHandle);
2079 >  FHandle := FpOpen(Filename,O_RdOnly);
2080 >  if FHandle = -1 then
2081 >     raise Exception.CreateFmt('Unable to open file %s',[Filename]);
2082 > {$ELSE}
2083 >  if FHandle <> 0 then
2084 >    CloseHandle(FHandle);
2085 >  FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
2086 >                        FILE_FLAG_SEQUENTIAL_SCAN, 0);
2087 >  if FHandle = INVALID_HANDLE_VALUE then
2088 >    FHandle := 0;
2089 > {$ENDIF}
2090 > end;
2091 >
2092 > { TIBSQL }
2093 > constructor TIBSQL.Create(AOwner: TComponent);
2094 > begin
2095 >  inherited Create(AOwner);
2096 >  FIBLoaded := False;
2097 >  CheckIBLoaded;
2098 >  FIBLoaded := True;
2099 >  FGenerateParamNames := False;
2100 >  FGoToFirstRecordOnExecute := True;
2101 >  FBase := TIBBase.Create(Self);
2102 >  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
2103 >  FBase.BeforeTransactionEnd := BeforeTransactionEnd;
2104 >  FBOF := False;
2105 >  FEOF := False;
2106 >  FPrepared := False;
2107 >  FRecordCount := 0;
2108 >  FSQL := TStringList.Create;
2109 >  TStringList(FSQL).OnChanging := SQLChanging;
2110 >  FProcessedSQL := TStringList.Create;
2111 >  FHandle := nil;
2112 >  FSQLParams := TIBXSQLDA.Create(self,daInput);
2113 >  FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2114 >  FSQLType := SQLUnknown;
2115 >  FParamCheck := True;
2116 >  FCursor := Name + RandomString(8);
2117 >  if AOwner is TIBDatabase then
2118 >    Database := TIBDatabase(AOwner)
2119 >  else
2120 >    if AOwner is TIBTransaction then
2121 >      Transaction := TIBTransaction(AOwner);
2122 > end;
2123 >
2124 > destructor TIBSQL.Destroy;
2125 > begin
2126 >  if FIBLoaded then
2127 >  begin
2128 >    if (FOpen) then
2129 >      Close;
2130 >    if (FHandle <> nil) then
2131 >      FreeHandle;
2132 >    FSQL.Free;
2133 >    FProcessedSQL.Free;
2134 >    FBase.Free;
2135 >    FSQLParams.Free;
2136 >    FSQLRecord.Free;
2137 >  end;
2138 >  inherited Destroy;
2139 > end;
2140 >
2141 > procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
2142 > begin
2143 >  if not Prepared then
2144 >    Prepare;
2145 >  InputObject.FParams := Self.FSQLParams;
2146 >  InputObject.ReadyFile;
2147 >  if FSQLType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
2148 >    while InputObject.ReadParameters do
2149 >      ExecQuery;
2150 > end;
2151 >
2152 > procedure TIBSQL.BatchOutput(OutputObject: TIBBatchOutput);
2153 > begin
2154 >  CheckClosed;
2155 >  if not Prepared then
2156 >    Prepare;
2157 >  if FSQLType = SQLSelect then begin
2158 >    try
2159 >      ExecQuery;
2160 >      OutputObject.FColumns := Self.FSQLRecord;
2161 >      OutputObject.ReadyFile;
2162 >      if not FGoToFirstRecordOnExecute then
2163 >        Next;
2164 >      while (not Eof) and (OutputObject.WriteColumns) do
2165 >        Next;
2166 >    finally
2167 >      Close;
2168 >    end;
2169 >  end;
2170 > end;
2171 >
2172 > procedure TIBSQL.CheckClosed;
2173 > begin
2174 >  if FOpen then IBError(ibxeSQLOpen, [nil]);
2175 > end;
2176 >
2177 > procedure TIBSQL.CheckOpen;
2178 > begin
2179 >  if not FOpen then IBError(ibxeSQLClosed, [nil]);
2180 > end;
2181 >
2182 > procedure TIBSQL.CheckValidStatement;
2183 > begin
2184 >  FBase.CheckTransaction;
2185 >  if (FHandle = nil) then
2186 >    IBError(ibxeInvalidStatementHandle, [nil]);
2187 > end;
2188 >
2189 > procedure TIBSQL.Close;
2190 > var
2191 >  isc_res: ISC_STATUS;
2192 > begin
2193 >  try
2194 >    if (FHandle <> nil) and (SQLType = SQLSelect) and FOpen then begin
2195 >      isc_res := Call(
2196 >                   isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
2197 >                   False);
2198 >      if (StatusVector^ = 1) and (isc_res > 0) and
2199 >        not CheckStatusVector(
2200 >              [isc_bad_stmt_handle, isc_dsql_cursor_close_err]) then
2201 >        IBDatabaseError;
2202 >    end;
2203 >  finally
2204 >    FEOF := False;
2205 >    FBOF := False;
2206 >    FOpen := False;
2207 >    FRecordCount := 0;
2208 >  end;
2209 > end;
2210 >
2211 > function TIBSQL.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
2212 > begin
2213 >  result := 0;
2214 > if Transaction <> nil then
2215 >    result := Transaction.Call(ErrCode, RaiseError)
2216 >  else
2217 >  if RaiseError and (ErrCode > 0) then
2218 >    IBDataBaseError;
2219 > end;
2220 >
2221 > function TIBSQL.Current: TIBXSQLDA;
2222 > 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
2241 >    Close;
2242 >    FreeHandle;
2243 >  end;
2244 > end;
2245 >
2246 > procedure TIBSQL.ExecQuery;
2247 > var
2248 >  fetch_res: ISC_STATUS;
2249 > begin
2250 >  CheckClosed;
2251 >  if not Prepared then Prepare;
2252 >  CheckValidStatement;
2253 >  case FSQLType of
2254 >    SQLSelect: begin
2255 >      Call(isc_dsql_execute2(StatusVector,
2256 >                            TRHandle,
2257 >                            @FHandle,
2258 >                            Database.SQLDialect,
2259 >                            FSQLParams.AsXSQLDA,
2260 >                            nil), True);
2261 >      Call(
2262 >        isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
2263 >        True);
2264 >      FOpen := True;
2265 >      FBOF := True;
2266 >      FEOF := False;
2267 >      FRecordCount := 0;
2268 >      if FGoToFirstRecordOnExecute then
2269 >        Next;
2270 >    end;
2271 >    SQLExecProcedure: begin
2272 >      fetch_res := Call(isc_dsql_execute2(StatusVector,
2273 >                            TRHandle,
2274 >                            @FHandle,
2275 >                            Database.SQLDialect,
2276 >                            FSQLParams.AsXSQLDA,
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
2282 >           to work around the problem simply by "retrying". This
2283 >           need to be reproduced and fixed.
2284 >         }
2285 >        isc_dsql_prepare(StatusVector, TRHandle, @FHandle, 0,
2286 >                         PChar(FProcessedSQL.Text), 1, nil);
2287 >        Call(isc_dsql_execute2(StatusVector,
2288 >                            TRHandle,
2289 >                            @FHandle,
2290 >                            Database.SQLDialect,
2291 >                            FSQLParams.AsXSQLDA,
2292 >                            FSQLRecord.AsXSQLDA), True);
2293 >      end;  *)
2294 >    end
2295 >    else
2296 >      Call(isc_dsql_execute(StatusVector,
2297 >                           TRHandle,
2298 >                           @FHandle,
2299 >                           Database.SQLDialect,
2300 >                           FSQLParams.AsXSQLDA), True)
2301 >  end;
2302 >  if not (csDesigning in ComponentState) then
2303 >    MonitorHook.SQLExecute(Self);
2304 > end;
2305 >
2306 > function TIBSQL.GetEOF: Boolean;
2307 > begin
2308 >  result := FEOF or not FOpen;
2309 > end;
2310 >
2311 > function TIBSQL.FieldByName(FieldName: String): TIBXSQLVAR;
2312 > var
2313 >  i: Integer;
2314 > begin
2315 >  i := GetFieldIndex(FieldName);
2316 >  if (i < 0) then
2317 >    IBError(ibxeFieldNotFound, [FieldName]);
2318 >  result := GetFields(i);
2319 > end;
2320 >
2321 > function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2322 > begin
2323 >  Result := Params.ByName(ParamName);
2324 > end;
2325 >
2326 > function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2327 > begin
2328 >  if (Idx < 0) or (Idx >= FSQLRecord.Count) then
2329 >    IBError(ibxeFieldNotFound, [IntToStr(Idx)]);
2330 >  result := FSQLRecord[Idx];
2331 > end;
2332 >
2333 > function TIBSQL.GetFieldIndex(FieldName: String): Integer;
2334 > begin
2335 >  if (FSQLRecord.GetXSQLVarByName(FieldName) = nil) then
2336 >    result := -1
2337 >  else
2338 >    result := FSQLRecord.GetXSQLVarByName(FieldName).Index;
2339 > end;
2340 >
2341 > function TIBSQL.Next: TIBXSQLDA;
2342 > var
2343 >  fetch_res: ISC_STATUS;
2344 > begin
2345 >  result := nil;
2346 >  if not FEOF then begin
2347 >    CheckOpen;
2348 >    { Go to the next record... }
2349 >    fetch_res :=
2350 >      Call(isc_dsql_fetch(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.AsXSQLDA), False);
2351 >    if (fetch_res = 100) or (CheckStatusVector([isc_dsql_cursor_err])) then begin
2352 >      FEOF := True;
2353 >    end else if (fetch_res > 0) then begin
2354 >      try
2355 >        IBDataBaseError;
2356 >      except
2357 >        Close;
2358 >        raise;
2359 >      end;
2360 >    end else begin
2361 >      Inc(FRecordCount);
2362 >      FBOF := False;
2363 >      result := FSQLRecord;
2364 >    end;
2365 >    if not (csDesigning in ComponentState) then
2366 >      MonitorHook.SQLFetch(Self);
2367 >  end;
2368 > end;
2369 >
2370 > procedure TIBSQL.FreeHandle;
2371 > var
2372 >  isc_res: ISC_STATUS;
2373 > begin
2374 >  try
2375 >    { The following two lines merely set the SQLDA count
2376 >     variable FCount to 0, but do not deallocate
2377 >     That way the allocations can be reused for
2378 >     a new query sring in the same SQL instance }
2379 >    FSQLRecord.Count := 0;
2380 >    FSQLParams.Count := 0;
2381 >    if FHandle <> nil then begin
2382 >      isc_res :=
2383 >        Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
2384 >      if (StatusVector^ = 1) and (isc_res > 0) and (isc_res <> isc_bad_stmt_handle) then
2385 >        IBDataBaseError;
2386 >    end;
2387 >  finally
2388 >    FPrepared := False;
2389 >    FHandle := nil;
2390 >  end;
2391 > end;
2392 >
2393 > function TIBSQL.GetDatabase: TIBDatabase;
2394 > begin
2395 >  result := FBase.Database;
2396 > end;
2397 >
2398 > function TIBSQL.GetDBHandle: PISC_DB_HANDLE;
2399 > begin
2400 >  result := FBase.DBHandle;
2401 > end;
2402 >
2403 > function TIBSQL.GetPlan: String;
2404 > var
2405 >  result_buffer: array[0..16384] of Char;
2406 >  result_length, i: Integer;
2407 >  info_request: Char;
2408 > begin
2409 >  if (not Prepared) or
2410 >     (not (FSQLType in [SQLSelect, SQLSelectForUpdate,
2411 >       {TODO: SQLExecProcedure, }
2412 >       SQLUpdate, SQLDelete])) then
2413 >    result := ''
2414 >  else begin
2415 >    info_request := Char(isc_info_sql_get_plan);
2416 >    Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2417 >                           SizeOf(result_buffer), result_buffer), True);
2418 >    if (result_buffer[0] <> Char(isc_info_sql_get_plan)) then
2419 >      IBError(ibxeUnknownError, [nil]);
2420 >    result_length := isc_vax_integer(@result_buffer[1], 2);
2421 >    SetString(result, nil, result_length);
2422 >    for i := 1 to result_length do
2423 >      result[i] := result_buffer[i + 2];
2424 >    result := Trim(result);
2425 >  end;
2426 > end;
2427 >
2428 > function TIBSQL.GetRecordCount: Integer;
2429 > begin
2430 >  result := FRecordCount;
2431 > end;
2432 >
2433 > function TIBSQL.GetRowsAffected: Integer;
2434 > var
2435 >  result_buffer: array[0..1048] of Char;
2436 >  info_request: Char;
2437 > begin
2438 >  if not Prepared then
2439 >    result := -1
2440 >  else begin
2441 >    info_request := Char(isc_info_sql_records);
2442 >    if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2443 >                         SizeOf(result_buffer), result_buffer) > 0 then
2444 >      IBDatabaseError;
2445 >    if (result_buffer[0] <> Char(isc_info_sql_records)) then
2446 >      result := -1
2447 >    else
2448 >    case SQLType of
2449 >    SQLUpdate:   Result := isc_vax_integer(@result_buffer[6], 4);
2450 >    SQLDelete:   Result := isc_vax_integer(@result_buffer[13], 4);
2451 >    SQLInsert:   Result := isc_vax_integer(@result_buffer[27], 4);
2452 >    else         Result := -1 ;
2453 >    end ;
2454 >  end;
2455 > end;
2456 >
2457 > function TIBSQL.GetSQLParams: TIBXSQLDA;
2458 > begin
2459 >  if not Prepared then
2460 >    Prepare;
2461 >  result := FSQLParams;
2462 > end;
2463 >
2464 > function TIBSQL.GetTransaction: TIBTransaction;
2465 > begin
2466 >  result := FBase.Transaction;
2467 > end;
2468 >
2469 > function TIBSQL.GetTRHandle: PISC_TR_HANDLE;
2470 > begin
2471 >  result := FBase.TRHandle;
2472 > end;
2473 >
2474 > {
2475 > Preprocess SQL
2476 > Using FSQL, process the typed SQL and put the process SQL
2477 > in FProcessedSQL and parameter names in FSQLParams
2478 > }
2479 > procedure TIBSQL.PreprocessSQL;
2480 > var
2481 >  cCurChar, cNextChar, cQuoteChar: Char;
2482 >  sSQL, sProcessedSQL, sParamName: String;
2483 >  i, iLenSQL, iSQLPos: Integer;
2484 >  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2485 >  iParamSuffix: Integer;
2486 >  slNames: TStrings;
2487 >
2488 > const
2489 >  DefaultState = 0;
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
2500 >    sProcessedSQL[iSQLPos] := cChar;
2501 >    Inc(iSQLPos);
2502 >  end;
2503 >
2504 > begin
2505 >  slNames := TStringList.Create;
2506 >  try
2507 >    { Do some initializations of variables }
2508 >    iParamSuffix := 0;
2509 >    cQuoteChar := '''';
2510 >    sSQL := FSQL.Text;
2511 >    iLenSQL := Length(sSQL);
2512 >    SetString(sProcessedSQL, nil, iLenSQL + 1);
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
2522 >      { Get the current token and a look-ahead }
2523 >      cCurChar := sSQL[i];
2524 >      if i = iLenSQL then
2525 >        cNextChar := #0
2526 >      else
2527 >        cNextChar := sSQL[i + 1];
2528 >      { Now act based on the current state }
2529 >      case iCurState of
2530 >        DefaultState: begin
2531 >          case cCurChar of
2532 >            '''', '"': begin
2533 >              cQuoteChar := cCurChar;
2534 >              iCurState := QuoteState;
2535 >            end;
2536 >            '?', ':': begin
2537 >              iCurState := ParamState;
2538 >              AddToProcessedSQL('?');
2539 >            end;
2540 >            '/': if (cNextChar = '*') then begin
2541 >              AddToProcessedSQL(cCurChar);
2542 >              Inc(i);
2543 >              iCurState := CommentState;
2544 >            end;
2545 >          end;
2546 >        end;
2547 >        CommentState: begin
2548 >          if (cNextChar = #0) then
2549 >            IBError(ibxeSQLParseError, [SEOFInComment])
2550 >          else if (cCurChar = '*') then begin
2551 >            if (cNextChar = '/') then
2552 >              iCurState := DefaultState;
2553 >          end;
2554 >        end;
2555 >        QuoteState: begin
2556 >          if cNextChar = #0 then
2557 >            IBError(ibxeSQLParseError, [SEOFInString])
2558 >          else if (cCurChar = cQuoteChar) then begin
2559 >            if (cNextChar = cQuoteChar) then begin
2560 >              AddToProcessedSQL(cCurChar);
2561 >              Inc(i);
2562 >            end else
2563 >              iCurState := DefaultState;
2564 >          end;
2565 >        end;
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
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.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 }
2593 >            if cCurChar = '"' then
2594 >            begin
2595 >              Inc(i);
2596 >              slNames.Add(sParamName);
2597 >              SParamName := '';
2598 >              iCurParamState := ParamDefaultState;
2599 >              iCurState := DefaultState;
2600 >            end
2601 >            else
2602 >              sParamName := sParamName + cCurChar
2603 >          end;
2604 >          {$endif}
2605 >          { determine if the unquoted parameter name is finished }
2606 >          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2607 >            (iCurState <> DefaultState) then
2608 >          begin
2609 >            if not (cNextChar in ['A'..'Z', 'a'..'z',
2610 >                                  '0'..'9', '_', '$']) then begin
2611 >              Inc(i);
2612 >              iCurState := DefaultState;
2613 >              slNames.Add(sParamName);
2614 >              sParamName := '';
2615 >            end;
2616 >          end;
2617 >        end;
2618 >      end;
2619 >      if iCurState <> ParamState then
2620 >        AddToProcessedSQL(sSQL[i]);
2621 >      Inc(i);
2622 >    end;
2623 >    AddToProcessedSQL(#0);
2624 >    FSQLParams.Count := slNames.Count;
2625 >    for i := 0 to slNames.Count - 1 do
2626 >      FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2627 >    FProcessedSQL.Text := sProcessedSQL;
2628 >  finally
2629 >    slNames.Free;
2630 >  end;
2631 > end;
2632 >
2633 > procedure TIBSQL.SetDatabase(Value: TIBDatabase);
2634 > begin
2635 >  FBase.Database := Value;
2636 > end;
2637 >
2638 > procedure TIBSQL.Prepare;
2639 > var
2640 >  stmt_len: Integer;
2641 >  res_buffer: array[0..7] of Char;
2642 >  type_item: Char;
2643 > begin
2644 >  CheckClosed;
2645 >  FBase.CheckDatabase;
2646 >  FBase.CheckTransaction;
2647 >  if FPrepared then
2648 >    exit;
2649 >  if (FSQL.Text = '') then
2650 >    IBError(ibxeEmptyQuery, [nil]);
2651 >  if not ParamCheck then
2652 >    FProcessedSQL.Text := FSQL.Text
2653 >  else
2654 >    PreprocessSQL;
2655 >  if (FProcessedSQL.Text = '') then
2656 >    IBError(ibxeEmptyQuery, [nil]);
2657 >  try
2658 >    Call(isc_dsql_alloc_statement2(StatusVector, DBHandle,
2659 >                                    @FHandle), True);
2660 >    Call(isc_dsql_prepare(StatusVector, TRHandle, @FHandle, 0,
2661 >               PChar(FProcessedSQL.Text), Database.SQLDialect, nil), True);
2662 >    { After preparing the statement, query the stmt type and possibly
2663 >      create a FSQLRecord "holder" }
2664 >    { Get the type of the statement }
2665 >    type_item := Char(isc_info_sql_stmt_type);
2666 >    Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2667 >                         SizeOf(res_buffer), res_buffer), True);
2668 >    if (res_buffer[0] <> Char(isc_info_sql_stmt_type)) then
2669 >      IBError(ibxeUnknownError, [nil]);
2670 >    stmt_len := isc_vax_integer(@res_buffer[1], 2);
2671 >    FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
2672 >    { Done getting the type }
2673 >    case FSQLType of
2674 >      SQLGetSegment,
2675 >      SQLPutSegment,
2676 >      SQLStartTransaction: begin
2677 >        FreeHandle;
2678 >        IBError(ibxeNotPermitted, [nil]);
2679 >      end;
2680 >      SQLCommit,
2681 >      SQLRollback,
2682 >      SQLDDL, SQLSetGenerator,
2683 >      SQLInsert, SQLUpdate, SQLDelete, SQLSelect, SQLSelectForUpdate,
2684 >      SQLExecProcedure: begin
2685 >        { We already know how many inputs there are, so... }
2686 >        if (FSQLParams.FXSQLDA <> nil) and
2687 >           (Call(isc_dsql_describe_bind(StatusVector, @FHandle, Database.SQLDialect,
2688 >                                        FSQLParams.FXSQLDA), False) > 0) then
2689 >          IBDataBaseError;
2690 >        FSQLParams.Initialize;
2691 >        if FSQLType in [SQLSelect, SQLSelectForUpdate,
2692 >                        SQLExecProcedure] then begin
2693 >          { Allocate an initial output descriptor (with one column) }
2694 >          FSQLRecord.Count := 1;
2695 >          { Using isc_dsql_describe, get the right size for the columns... }
2696 >          Call(isc_dsql_describe(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.FXSQLDA), True);
2697 >          if FSQLRecord.FXSQLDA^.sqld > FSQLRecord.FXSQLDA^.sqln then begin
2698 >            FSQLRecord.Count := FSQLRecord.FXSQLDA^.sqld;
2699 >            Call(isc_dsql_describe(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.FXSQLDA), True);
2700 >          end else if FSQLRecord.FXSQLDA^.sqld = 0 then
2701 >            FSQLRecord.Count := 0;
2702 >          FSQLRecord.Initialize;
2703 >        end;
2704 >      end;
2705 >    end;
2706 >    FPrepared := True;
2707 >    if not (csDesigning in ComponentState) then
2708 >      MonitorHook.SQLPrepare(Self);
2709 >  except
2710 >    on E: Exception do begin
2711 >      if (FHandle <> nil) then
2712 >        FreeHandle;
2713 >      raise;
2714 >    end;
2715 >  end;
2716 > end;
2717 >
2718 > function TIBSQL.GetUniqueRelationName: String;
2719 > begin
2720 >  if FPrepared and (FSQLType = SQLSelect) then
2721 >    result := FSQLRecord.UniqueRelationName
2722 >  else
2723 >    result := '';
2724 > end;
2725 >
2726 > procedure TIBSQL.SetSQL(Value: TStrings);
2727 > begin
2728 >  if FSQL.Text <> Value.Text then
2729 >  begin
2730 >    FSQL.BeginUpdate;
2731 >    try
2732 >      FSQL.Assign(Value);
2733 >    finally
2734 >      FSQL.EndUpdate;
2735 >    end;
2736 >  end;
2737 > end;
2738 >
2739 > procedure TIBSQL.SetTransaction(Value: TIBTransaction);
2740 > begin
2741 >  FBase.Transaction := Value;
2742 > end;
2743 >
2744 > procedure TIBSQL.SQLChanging(Sender: TObject);
2745 > begin
2746 >  if Assigned(OnSQLChanging) then
2747 >    OnSQLChanging(Self);
2748 >  if FHandle <> nil then FreeHandle;
2749 > end;
2750 >
2751 > procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
2752 > begin
2753 >  if (FOpen) then
2754 >    Close;
2755 > end;
2756 >
2757 > end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines