ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBSQL.pas
(Generate patch)
# 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                                                 }
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 >