ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/runtime/nongui/IBSQL.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (2 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 29305 byte(s)
Log Message:
add fbintf

File Contents

# User Rev Content
1 tony 209 {************************************************************************}
2     { }
3     { Borland Delphi Visual Component Library }
4     { InterBase Express core components }
5     { }
6     { Copyright (c) 1998-2000 Inprise Corporation }
7     { }
8     { InterBase Express is based in part on the product }
9     { Free IB Components, written by Gregory H. Deatz for }
10     { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11     { Free IB Components is used under license. }
12     { }
13     { The contents of this file are subject to the InterBase }
14     { Public License Version 1.0 (the "License"); you may not }
15     { use this file except in compliance with the License. You }
16     { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17     { Software distributed under the License is distributed on }
18     { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19     { express or implied. See the License for the specific language }
20     { governing rights and limitations under the License. }
21     { The Original Code was created by InterBase Software Corporation }
22     { and its successors. }
23     { Portions created by Inprise Corporation are Copyright (C) Inprise }
24     { Corporation. All Rights Reserved. }
25     { Contributor(s): Jeff Overcash }
26     { }
27     { IBX For Lazarus (Firebird Express) }
28     { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29     { Portions created by MWA Software are copyright McCallum Whyman }
30     { Associates Ltd 2011 - 2014 }
31     { }
32     {************************************************************************}
33    
34     unit IBSQL;
35    
36     {$Mode Delphi}
37    
38     {$codepage UTF8}
39    
40     (* Define IBXQUERYSTATS to write to stdout a summary of query execution
41     statistics each time a query is executed
42    
43     Define IBXQUERYTIME to write to stdout The local execution time for each
44     query
45     *)
46    
47     { $DEFINE IBXQUERYSTATS}
48     { $DEFINE IBXQUERYTIME}
49    
50     interface
51    
52     uses
53     {$IFDEF WINDOWS }
54     Windows,
55     {$ELSE}
56     baseunix, unix,
57     {$ENDIF}
58     SysUtils, Classes, IB, IBDatabase, IBUtils;
59    
60     type
61     { TIBBatch }
62    
63     TIBBatch = class(TObject)
64     protected
65     FFilename: String;
66     FColumns: IResults;
67     FParams: ISQLParams;
68     public
69     procedure ReadyFile; virtual; abstract;
70     property Columns: IResults read FColumns;
71     property Filename: String read FFilename write FFilename;
72     property Params: ISQLParams read FParams;
73     end;
74    
75     TIBBatchInput = class(TIBBatch)
76     public
77     function ReadParameters: Boolean; virtual; abstract;
78     end;
79    
80     TIBBatchOutput = class(TIBBatch)
81     public
82     function WriteColumns: Boolean; virtual; abstract;
83     end;
84    
85    
86     { TIBOutputDelimitedFile }
87     TIBOutputDelimitedFile = class(TIBBatchOutput)
88     protected
89     {$IFDEF UNIX}
90     FHandle: cint;
91     {$ELSE}
92     FHandle: THandle;
93     {$ENDIF}
94     FOutputTitles: Boolean;
95     FColDelimiter,
96     FRowDelimiter: string;
97     public
98     destructor Destroy; override;
99     procedure ReadyFile; override;
100     function WriteColumns: Boolean; override;
101     property ColDelimiter: string read FColDelimiter write FColDelimiter;
102     property OutputTitles: Boolean read FOutputTitles
103     write FOutputTitles;
104     property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
105     end;
106    
107     { TIBInputDelimitedFile }
108     TIBInputDelimitedFile = class(TIBBatchInput)
109     protected
110     FColDelimiter,
111     FRowDelimiter: string;
112     FEOF: Boolean;
113     FFile: TFileStream;
114     FLookAhead: Char;
115     FReadBlanksAsNull: Boolean;
116     FSkipTitles: Boolean;
117     public
118     destructor Destroy; override;
119     function GetColumn(var Col: string): Integer;
120     function ReadParameters: Boolean; override;
121     procedure ReadyFile; override;
122     property ColDelimiter: string read FColDelimiter write FColDelimiter;
123     property ReadBlanksAsNull: Boolean read FReadBlanksAsNull
124     write FReadBlanksAsNull;
125     property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
126     property SkipTitles: Boolean read FSkipTitles write FSkipTitles;
127     end;
128    
129     { TIBOutputRawFile }
130     TIBOutputRawFile = class(TIBBatchOutput)
131     protected
132     {$IFDEF UNIX}
133     FHandle: cint;
134     {$ELSE}
135     FHandle: THandle;
136     {$ENDIF}
137     public
138     destructor Destroy; override;
139     procedure ReadyFile; override;
140     function WriteColumns: Boolean; override;
141     end;
142    
143     { TIBInputRawFile }
144     TIBInputRawFile = class(TIBBatchInput)
145     protected
146     {$IFDEF UNIX}
147     FHandle: cint;
148     {$ELSE}
149     FHandle: THandle;
150     {$ENDIF}
151     public
152     destructor Destroy; override;
153     function ReadParameters: Boolean; override;
154     procedure ReadyFile; override;
155     end;
156    
157     { TIBSQL }
158    
159     TIBSQL = class(TComponent)
160     private
161 tony 270 FCaseSensitiveParameterNames: boolean;
162 tony 209 FMetaData: IMetaData;
163 tony 353 FScrollable: boolean;
164 tony 209 FSQLParams: ISQLParams;
165     FStatement: IStatement;
166     FOnSQLChanged: TNotifyEvent;
167     FUniqueParamNames: Boolean;
168 tony 353 function GetBOF: Boolean;
169 tony 209 function GetFieldCount: integer;
170     function GetOpen: Boolean;
171     function GetPrepared: Boolean;
172     function GetSQLStatementType: TIBSQLStatementTypes;
173     procedure SetUniqueParamNames(AValue: Boolean);
174     protected
175     FBase: TIBBase;
176     FGoToFirstRecordOnExecute: boolean; { Automatically position record on first record after executing }
177     FRecordCount: Integer; { How many records have been read so far? }
178     FOnSQLChanging: TNotifyEvent; { Call this when the SQL is changing }
179     FSQL: TStrings; { SQL Query (by user) }
180     FParamCheck: Boolean; { Check for parameters? (just like TQuery) }
181     FResults: IResults; {Single row results from exec}
182     FResultSet: IResultSet; {Multi-row results from open cursor}
183     FGenerateParamNames: Boolean; { Auto generate param names ?}
184     procedure DoBeforeDatabaseDisconnect(Sender: TObject);
185     function GetDatabase: TIBDatabase;
186     function GetEOF: Boolean;
187     function GetFields(const Idx: Integer): ISQLData;
188     function GetFieldIndex(FieldName: String): Integer;
189     function GetPlan: String;
190     function GetRecordCount: Integer;
191 tony 345 function GetRowsAffected: Int64;
192 tony 209 function GetSQLParams: ISQLParams;
193     function GetTransaction: TIBTransaction;
194     procedure SetDatabase(Value: TIBDatabase);
195     procedure SetSQL(Value: TStrings);
196     procedure SetTransaction(Value: TIBTransaction);
197     procedure SQLChanging(Sender: TObject);
198     procedure SQLChanged(Sender: TObject);
199     procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
200     public
201     constructor Create(AOwner: TComponent); override;
202     destructor Destroy; override;
203     procedure BatchInput(InputObject: TIBBatchInput);
204     procedure BatchOutput(OutputObject: TIBBatchOutput);
205     procedure CheckClosed; { raise error if query is not closed. }
206     procedure CheckOpen; { raise error if query is not open.}
207     procedure CheckValidStatement; { raise error if statement is invalid.}
208     procedure Close;
209     procedure ExecQuery;
210 tony 229 function HasField(FieldName: String): boolean; {Note: case sensitive match}
211 tony 353 function HasScollableCursors: boolean;
212 tony 209 function FieldByName(FieldName: String): ISQLData;
213     function ParamByName(ParamName: String): ISQLParam;
214     procedure FreeHandle;
215     function Next: boolean;
216 tony 353 function FetchNext: boolean; {fetch next record}
217     function FetchPrior: boolean; {fetch previous record}
218     function FetchFirst:boolean; {fetch first record}
219     function FetchLast: boolean; {fetch last record}
220     function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
221     function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
222 tony 209 procedure Prepare;
223     function GetUniqueRelationName: String;
224 tony 353 property Bof: Boolean read GetBOF;
225 tony 209 property Eof: Boolean read GetEOF;
226     property Current: IResults read FResults;
227     property Fields[const Idx: Integer]: ISQLData read GetFields; default;
228     property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
229     property FieldCount: integer read GetFieldCount;
230     property Open: Boolean read GetOpen;
231     property Params: ISQLParams read GetSQLParams;
232     property Plan: String read GetPlan;
233     property Prepared: Boolean read GetPrepared;
234     property RecordCount: Integer read GetRecordCount;
235 tony 345 property RowsAffected: Int64 read GetRowsAffected;
236 tony 209 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
237     property UniqueRelationName: String read GetUniqueRelationName;
238     property Statement: IStatement read FStatement;
239     property MetaData: IMetaData read FMetaData;
240 tony 345 public
241     {Batch Interface}
242     function HasBatchMode: boolean;
243     function IsInBatchMode: boolean;
244     procedure AddToBatch;
245     function ExecuteBatch: IBatchCompletion;
246     procedure CancelBatch;
247     function GetBatchCompletion: IBatchCompletion;
248     function GetBatchRowLimit: integer;
249     procedure SetBatchRowLimit(aLimit: integer);
250 tony 209 published
251     property Database: TIBDatabase read GetDatabase write SetDatabase;
252 tony 270 property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames
253     write FCaseSensitiveParameterNames;
254 tony 209 property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
255     property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
256     property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
257     write FGoToFirstRecordOnExecute
258     default True;
259     property ParamCheck: Boolean read FParamCheck write FParamCheck;
260     property SQL: TStrings read FSQL write SetSQL;
261 tony 353 property Scrollable: boolean read FScrollable write FScrollable;
262 tony 209 property Transaction: TIBTransaction read GetTransaction write SetTransaction;
263     property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
264     property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
265     end;
266    
267     procedure IBAlloc(var P; OldSize, NewSize: Integer);
268    
269     implementation
270    
271     uses
272 tony 291 Variants, IBSQLMonitor, IBMessages, IBCustomDataSet;
273 tony 209
274     procedure IBAlloc(var P; OldSize, NewSize: Integer);
275     var
276     i: Integer;
277     begin
278     ReallocMem(Pointer(P), NewSize);
279     for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
280     end;
281    
282     { TIBOutputDelimitedFile }
283    
284     destructor TIBOutputDelimitedFile.Destroy;
285     begin
286     {$IFDEF UNIX}
287     if FHandle <> -1 then
288     fpclose(FHandle);
289     {$ELSE}
290     if FHandle <> 0 then
291     begin
292     FlushFileBuffers(FHandle);
293     CloseHandle(FHandle);
294     end;
295     {$ENDIF}
296     inherited Destroy;
297     end;
298    
299     procedure TIBOutputDelimitedFile.ReadyFile;
300     var
301     i: Integer;
302     {$IFDEF UNIX}
303     BytesWritten: cint;
304     {$ELSE}
305     BytesWritten: DWORD;
306     {$ENDIF}
307     st: string;
308     begin
309     if FColDelimiter = '' then
310     FColDelimiter := TAB;
311     if FRowDelimiter = '' then
312     FRowDelimiter := CRLF;
313     {$IFDEF UNIX}
314     FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
315     {$ELSE}
316     FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
317     FILE_ATTRIBUTE_NORMAL, 0);
318     if FHandle = INVALID_HANDLE_VALUE then
319     FHandle := 0;
320     {$ENDIF}
321     if FOutputTitles then
322     begin
323     for i := 0 to Columns.Count - 1 do
324     if i = 0 then
325     st := Columns[i].GetAliasname
326     else
327     st := st + FColDelimiter + Columns[i].GetAliasname;
328     st := st + FRowDelimiter;
329     {$IFDEF UNIX}
330     if FHandle <> -1 then
331     BytesWritten := FpWrite(FHandle,st[1],Length(st));
332     if BytesWritten = -1 then
333     raise Exception.Create('File Write Error');
334     {$ELSE}
335     WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
336     {$ENDIF}
337     end;
338     end;
339    
340     function TIBOutputDelimitedFile.WriteColumns: Boolean;
341     var
342     i: Integer;
343     {$IFDEF UNIX}
344     BytesWritten: cint;
345     {$ELSE}
346     BytesWritten: DWORD;
347     {$ENDIF}
348     st: string;
349     begin
350     result := False;
351     {$IFDEF UNIX}
352     if FHandle <> -1 then
353     {$ELSE}
354     if FHandle <> 0 then
355     {$ENDIF}
356     begin
357     st := '';
358     for i := 0 to Columns.Count - 1 do
359     begin
360     if i > 0 then
361     st := st + FColDelimiter;
362     st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
363     end;
364     st := st + FRowDelimiter;
365     {$IFDEF UNIX}
366     BytesWritten := FpWrite(FHandle,st[1],Length(st));
367     {$ELSE}
368     WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
369     {$ENDIF}
370     if BytesWritten = DWORD(Length(st)) then
371     result := True;
372     end
373     end;
374    
375     { TIBInputDelimitedFile }
376    
377     destructor TIBInputDelimitedFile.Destroy;
378     begin
379     FFile.Free;
380     inherited Destroy;
381     end;
382    
383     function TIBInputDelimitedFile.GetColumn(var Col: string): Integer;
384     var
385     c: Char;
386     BytesRead: Integer;
387    
388     procedure ReadInput;
389     begin
390     if FLookAhead <> NULL_TERMINATOR then
391     begin
392     c := FLookAhead;
393     BytesRead := 1;
394     FLookAhead := NULL_TERMINATOR;
395     end else
396     BytesRead := FFile.Read(c, 1);
397     end;
398    
399     procedure CheckCRLF(Delimiter: string);
400     begin
401     if (c = CR) and (Pos(LF, Delimiter) > 0) then {mbcs ok}
402     begin
403     BytesRead := FFile.Read(c, 1);
404     if (BytesRead = 1) and (c <> #10) then
405     FLookAhead := c
406     end;
407     end;
408    
409     begin
410     Col := '';
411     result := 0;
412     ReadInput;
413     while BytesRead <> 0 do begin
414     if Pos(c, FColDelimiter) > 0 then {mbcs ok}
415     begin
416     CheckCRLF(FColDelimiter);
417     result := 1;
418     break;
419     end else if Pos(c, FRowDelimiter) > 0 then {mbcs ok}
420     begin
421     CheckCRLF(FRowDelimiter);
422     result := 2;
423     break;
424     end else
425     Col := Col + c;
426     ReadInput;
427     end;
428     end;
429    
430     function TIBInputDelimitedFile.ReadParameters: Boolean;
431     var
432     i, curcol: Integer;
433     Col: string;
434     begin
435     result := False;
436     if not FEOF then begin
437     curcol := 0;
438     repeat
439     i := GetColumn(Col);
440     if (i = 0) then
441     FEOF := True;
442     if (curcol < Params.Count) then
443     begin
444     try
445     if (Col = '') and
446     (ReadBlanksAsNull) then
447     Params[curcol].IsNull := True
448     else
449     Params[curcol].AsString := Col;
450     Inc(curcol);
451     except
452     on E: Exception do begin
453     if not (FEOF and (curcol = Params.Count)) then
454     raise;
455     end;
456     end;
457     end;
458     until (FEOF) or (i = 2);
459     result := ((FEOF) and (curcol = Params.Count)) or
460     (not FEOF);
461     end;
462     end;
463    
464     procedure TIBInputDelimitedFile.ReadyFile;
465     begin
466     if FColDelimiter = '' then
467     FColDelimiter := TAB;
468     if FRowDelimiter = '' then
469     FRowDelimiter := CRLF;
470     FLookAhead := NULL_TERMINATOR;
471     FEOF := False;
472     if FFile <> nil then
473     FFile.Free;
474     FFile := TFileStream.Create(FFilename, fmOpenRead or fmShareDenyWrite);
475     if FSkipTitles then
476     ReadParameters;
477     end;
478    
479     { TIBOutputRawFile }
480     destructor TIBOutputRawFile.Destroy;
481     begin
482     {$IFDEF UNIX}
483     if FHandle <> -1 then
484     fpclose(FHandle);
485     {$ELSE}
486     if FHandle <> 0 then
487     begin
488     FlushFileBuffers(FHandle);
489     CloseHandle(FHandle);
490     end;
491     {$ENDIF}
492     inherited Destroy;
493     end;
494    
495     procedure TIBOutputRawFile.ReadyFile;
496     begin
497     {$IFDEF UNIX}
498     FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
499     {$ELSE}
500     FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
501     FILE_ATTRIBUTE_NORMAL, 0);
502     if FHandle = INVALID_HANDLE_VALUE then
503     FHandle := 0;
504     {$ENDIF}
505     end;
506    
507     function TIBOutputRawFile.WriteColumns: Boolean;
508     var
509     i: Integer;
510     BytesWritten: DWord;
511     begin
512     result := False;
513     if FHandle <> 0 then
514     begin
515     for i := 0 to Columns.Count - 1 do
516     begin
517     {$IFDEF UNIX}
518     BytesWritten := FpWrite(FHandle,Columns[i].GetAsPointer^, Columns[i].GetSize);
519     {$ELSE}
520     WriteFile(FHandle, Columns[i].GetAsPointer^, Columns[i].GetSize,
521     BytesWritten, nil);
522     {$ENDIF}
523     if BytesWritten <> DWORD(Columns[i].GetSize) then
524     exit;
525     end;
526     result := True;
527     end;
528     end;
529    
530     { TIBInputRawFile }
531     destructor TIBInputRawFile.Destroy;
532     begin
533     {$IFDEF UNIX}
534     if FHandle <> -1 then
535     fpclose(FHandle);
536     {$ELSE}
537     if FHandle <> 0 then
538     CloseHandle(FHandle);
539     {$ENDIF}
540     inherited Destroy;
541     end;
542    
543     function TIBInputRawFile.ReadParameters: Boolean;
544     var
545     i: Integer;
546     BytesRead: DWord;
547     begin
548     result := False;
549     {$IFDEF UNIX}
550     if FHandle <> -1 then
551     {$ELSE}
552     if FHandle <> 0 then
553     {$ENDIF}
554     begin
555     for i := 0 to Params.Count - 1 do
556     begin
557     {$IFDEF UNIX}
558     BytesRead := FpRead(FHandle,Params[i].GetAsPointer^,Params[i].GetSize);
559     {$ELSE}
560     ReadFile(FHandle, Params[i].GetAsPointer^, Params[i].GetSize,
561     BytesRead, nil);
562     {$ENDIF}
563     if BytesRead <> DWORD(Params[i].GetSize) then
564     exit;
565     end;
566     result := True;
567     end;
568     end;
569    
570     procedure TIBInputRawFile.ReadyFile;
571     begin
572     {$IFDEF UNIX}
573     if FHandle <> -1 then
574     fpclose(FHandle);
575     FHandle := FpOpen(Filename,O_RdOnly);
576     if FHandle = -1 then
577     raise Exception.CreateFmt('Unable to open file %s',[Filename]);
578     {$ELSE}
579     if FHandle <> 0 then
580     CloseHandle(FHandle);
581     FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
582     FILE_FLAG_SEQUENTIAL_SCAN, 0);
583     if FHandle = INVALID_HANDLE_VALUE then
584     FHandle := 0;
585     {$ENDIF}
586     end;
587    
588     { TIBSQL }
589     constructor TIBSQL.Create(AOwner: TComponent);
590     begin
591     inherited Create(AOwner);
592     FGenerateParamNames := False;
593     FGoToFirstRecordOnExecute := True;
594     FBase := TIBBase.Create(Self);
595     FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
596     FBase.BeforeTransactionEnd := BeforeTransactionEnd;
597     FRecordCount := 0;
598     FSQL := TStringList.Create;
599     TStringList(FSQL).OnChanging := SQLChanging;
600     TStringList(FSQL).OnChange := SQLChanged;
601     FParamCheck := True;
602     if AOwner is TIBDatabase then
603     Database := TIBDatabase(AOwner)
604     else
605     if AOwner is TIBTransaction then
606     Transaction := TIBTransaction(AOwner);
607     end;
608    
609     destructor TIBSQL.Destroy;
610     begin
611     FreeHandle;
612     FSQL.Free;
613     FBase.Free;
614     inherited Destroy;
615     end;
616    
617     procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
618     begin
619     if not Prepared then
620     Prepare;
621     InputObject.FParams := Self.GetSQLParams;
622     InputObject.ReadyFile;
623     if GetSQLStatementType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
624     while InputObject.ReadParameters do
625     ExecQuery;
626     end;
627    
628     procedure TIBSQL.BatchOutput(OutputObject: TIBBatchOutput);
629     begin
630     CheckClosed;
631     if not Prepared then
632     Prepare;
633     if GetSQLStatementType = SQLSelect then begin
634     try
635     ExecQuery;
636     OutputObject.FColumns := Self.FResults;
637     OutputObject.ReadyFile;
638     if not FGoToFirstRecordOnExecute then
639     Next;
640     while (not Eof) and (OutputObject.WriteColumns) do
641     Next;
642     finally
643     Close;
644     end;
645     end;
646     end;
647    
648     procedure TIBSQL.CheckClosed;
649     begin
650     if FResultSet <> nil then IBError(ibxeSQLOpen, [nil]);
651     end;
652    
653     procedure TIBSQL.CheckOpen;
654     begin
655     if FResultSet = nil then IBError(ibxeSQLClosed, [nil]);
656     end;
657    
658     procedure TIBSQL.CheckValidStatement;
659     begin
660     FBase.CheckTransaction;
661     if (FStatement = nil) then
662     IBError(ibxeInvalidStatementHandle, [nil]);
663     end;
664    
665     procedure TIBSQL.Close;
666     begin
667     if FResults <> nil then
668     FResults.SetRetainInterfaces(false);
669     FResultSet := nil;
670     FResults := nil;
671     FRecordCount := 0;
672     end;
673    
674     function TIBSQL.GetFieldCount: integer;
675     begin
676     if FResults <> nil then
677     Result := FResults.GetCount
678     else
679     if FMetaData <> nil then
680     Result := FMetaData.GetCount
681     else
682     Result := 0;
683     end;
684    
685 tony 353 function TIBSQL.GetBOF: Boolean;
686     begin
687     Result := (FResultSet = nil) or FResultSet.IsBof;
688     end;
689    
690 tony 209 function TIBSQL.GetOpen: Boolean;
691     begin
692     Result := FResultSet <> nil;
693     end;
694    
695     function TIBSQL.GetPrepared: Boolean;
696     begin
697     Result := (FStatement <> nil) and FStatement.IsPrepared;
698     end;
699    
700     function TIBSQL.GetSQLStatementType: TIBSQLStatementTypes;
701     begin
702     if FStatement = nil then
703     Result := SQLUnknown
704     else
705     Result := FStatement.GetSQLStatementType;
706     end;
707    
708     procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
709     begin
710     if FUniqueParamNames = AValue then Exit;
711     FreeHandle;
712     FUniqueParamNames := AValue;
713     end;
714    
715     procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
716     begin
717     FreeHandle;
718     end;
719    
720     procedure TIBSQL.ExecQuery;
721     {$IFDEF IBXQUERYSTATS}
722     var
723     stats: TPerfCounters;
724     {$ENDIF}
725     {$IFDEF IBXQUERYTIME}
726     var
727     tmsecs: comp;
728     {$ENDIF}
729     begin
730     CheckClosed;
731     if not Prepared then Prepare;
732     CheckValidStatement;
733     {$IFDEF IBXQUERYTIME}
734     tmsecs := TimeStampToMSecs(DateTimeToTimeStamp(Now));
735     {$ENDIF}
736     if SQLStatementType = SQLSelect then
737     begin
738 tony 353 FResultSet := FStatement.OpenCursor(Scrollable);
739 tony 209 FResults := FResultSet;
740     FResults.SetRetainInterfaces(true);
741     FRecordCount := 0;
742     if not (csDesigning in ComponentState) then
743     MonitorHook.SQLExecute(Self);
744     if FGoToFirstRecordOnExecute then
745     Next;
746     end
747     else
748     begin
749     FResults := FStatement.Execute;
750     if not (csDesigning in ComponentState) then
751     MonitorHook.SQLExecute(Self);
752     end;
753 tony 363
754 tony 209 {$IFDEF IBXQUERYTIME}
755     writeln('Executing ',FStatement.GetSQLText,
756     ' Response time= ',Format('%f msecs',[TimeStampToMSecs(DateTimeToTimeStamp(Now)) - tmsecs]));
757     {$ENDIF}
758     {$IFDEF IBXQUERYSTATS}
759     if FStatement.GetPerfStatistics(stats) then
760     writeln('Executing ',FStatement.GetSQLText,
761     ' Elapsed time= ', FormatFloat('#0.000',stats[psRealTime]/1000),' sec');
762     {$ENDIF}
763     FBase.DoAfterExecQuery(self);
764     end;
765    
766     function TIBSQL.HasField(FieldName: String): boolean;
767 tony 229 var i: integer;
768 tony 209 begin
769 tony 229 if MetaData = nil then
770 tony 209 IBError(ibxeNoFieldAccess,[nil]);
771    
772 tony 229 Result := false;
773     for i := 0 to MetaData.Count - 1 do
774     begin
775     if MetaData.ColMetaData[i].Name = FieldName then
776     begin
777     Result := true;
778     Exit;
779     end;
780     end;
781 tony 209 end;
782    
783 tony 353 function TIBSQL.HasScollableCursors: boolean;
784     begin
785     Result := Database.Attachment.HasScollableCursors;
786     end;
787    
788 tony 209 function TIBSQL.GetEOF: Boolean;
789     begin
790 tony 353 result := (FResultSet = nil) or FResultSet.IsEof;
791 tony 209 end;
792    
793     function TIBSQL.FieldByName(FieldName: String): ISQLData;
794     begin
795     if FResults = nil then
796     IBError(ibxeNoFieldAccess,[nil]);
797    
798     Result := FResults.ByName(FieldName);
799    
800     if Result = nil then
801     IBError(ibxeFieldNotFound, [FieldName]);
802     end;
803    
804     function TIBSQL.ParamByName(ParamName: String): ISQLParam;
805     begin
806     Result := Params.ByName(ParamName);
807     end;
808    
809     function TIBSQL.GetFields(const Idx: Integer): ISQLData;
810     begin
811     if FResults = nil then
812     IBError(ibxeNoFieldAccess,[nil]);
813    
814     if (Idx < 0) or (Idx >= FResults.GetCount) then
815     IBError(ibxeFieldNotFound, [IntToStr(Idx)]);
816     result := FResults[Idx];
817     end;
818    
819     function TIBSQL.GetFieldIndex(FieldName: String): Integer;
820     var Field: IColumnMetaData;
821     begin
822     if FMetaData = nil then
823     IBError(ibxeNoFieldAccess,[nil]);
824    
825     Field := FMetaData.ByName(FieldName);
826    
827     if Field = nil then
828     result := -1
829     else
830     result := Field.GetIndex;
831     end;
832    
833     function TIBSQL.Next: boolean;
834     begin
835 tony 353 Result := FetchNext;
836     end;
837    
838     function TIBSQL.FetchNext: boolean;
839     begin
840 tony 209 result := false;
841 tony 353 if not EOF then
842 tony 209 begin
843     CheckOpen;
844     try
845     Result := FResultSet.FetchNext;
846     except
847     Close;
848     raise;
849     end;
850    
851 tony 353 if Result and not Scrollable then
852 tony 209 Inc(FRecordCount);
853    
854     if not (csDesigning in ComponentState) then
855     MonitorHook.SQLFetch(Self);
856     end;
857     end;
858    
859 tony 353 function TIBSQL.FetchPrior: boolean;
860     begin
861     result := false;
862     if not BOF then
863     begin
864     CheckOpen;
865     try
866     Result := FResultSet.FetchPrior;
867     except
868     Close;
869     raise;
870     end;
871    
872     if not (csDesigning in ComponentState) then
873     MonitorHook.SQLFetch(Self);
874     end;
875     end;
876    
877     function TIBSQL.FetchFirst: boolean;
878     begin
879     result := false;
880     CheckOpen;
881     try
882     Result := FResultSet.FetchFirst;
883     except
884     Close;
885     raise;
886     end;
887    
888     if not (csDesigning in ComponentState) then
889     MonitorHook.SQLFetch(Self);
890     end;
891    
892     function TIBSQL.FetchLast: boolean;
893     begin
894     result := false;
895     CheckOpen;
896     try
897     Result := FResultSet.FetchLast;
898     except
899     Close;
900     raise;
901     end;
902    
903     if not (csDesigning in ComponentState) then
904     MonitorHook.SQLFetch(Self);
905     end;
906    
907     function TIBSQL.FetchAbsolute(position: Integer): boolean;
908     begin
909     result := false;
910     CheckOpen;
911     try
912     Result := FResultSet.FetchAbsolute(position);
913     except
914     Close;
915     raise;
916     end;
917    
918     if not (csDesigning in ComponentState) then
919     MonitorHook.SQLFetch(Self);
920     end;
921    
922     function TIBSQL.FetchRelative(offset: Integer): boolean;
923     begin
924     result := false;
925     CheckOpen;
926     try
927     Result := FResultSet.FetchRelative(offset);
928     except
929     Close;
930     raise;
931     end;
932    
933     if not (csDesigning in ComponentState) then
934     MonitorHook.SQLFetch(Self);
935     end;
936    
937 tony 209 procedure TIBSQL.FreeHandle;
938     begin
939     if FStatement <> nil then
940     FStatement.SetRetainInterfaces(false);
941     Close;
942     FStatement := nil;
943     FResults := nil;
944     FResultSet := nil;
945     FMetaData := nil;
946     FSQLParams := nil;
947     end;
948    
949     function TIBSQL.GetDatabase: TIBDatabase;
950     begin
951     result := FBase.Database;
952     end;
953    
954     function TIBSQL.GetPlan: String;
955     begin
956     if (not Prepared) or
957     (not (GetSQLStatementType in [SQLSelect, SQLSelectForUpdate,
958     {TODO: SQLExecProcedure, }
959     SQLUpdate, SQLDelete])) then
960     result := ''
961     else
962     Result := FStatement.GetPlan;
963     end;
964    
965     function TIBSQL.GetRecordCount: Integer;
966     begin
967     Result := FRecordCount;
968     end;
969    
970 tony 345 function TIBSQL.GetRowsAffected: Int64;
971 tony 209 var
972     SelectCount, InsertCount, UpdateCount, DeleteCount: integer;
973     begin
974     if not Prepared then
975     Result := -1
976     else
977     begin
978     FStatement.GetRowsAffected(SelectCount, InsertCount, UpdateCount, DeleteCount);
979     Result := InsertCount + UpdateCount + DeleteCount;
980     end;
981     end;
982    
983     function TIBSQL.GetSQLParams: ISQLParams;
984     begin
985     if not Prepared then
986     Prepare;
987     result := Statement.SQLParams;
988     end;
989    
990     function TIBSQL.GetTransaction: TIBTransaction;
991     begin
992     result := FBase.Transaction;
993     end;
994    
995     procedure TIBSQL.SetDatabase(Value: TIBDatabase);
996     begin
997     if Value = FBase.Database then Exit;
998     FBase.Database := Value;
999     FreeHandle;
1000     end;
1001    
1002     procedure TIBSQL.Prepare;
1003     begin
1004     CheckClosed;
1005     FBase.CheckDatabase;
1006     FBase.CheckTransaction;
1007     Close;
1008     if Prepared then
1009     exit;
1010     if (FSQL.Text = '') then
1011     IBError(ibxeEmptyQuery, [nil]);
1012    
1013     if FStatement <> nil then
1014     FStatement.Prepare(Transaction.TransactionIntf)
1015     else
1016     if not ParamCheck then
1017     FStatement := Database.Attachment.Prepare(Transaction.TransactionIntf,SQL.Text)
1018     else
1019     FStatement := Database.Attachment.PrepareWithNamedParameters(
1020     Transaction.TransactionIntf,
1021     SQL.Text,
1022 tony 270 GenerateParamNames,
1023     CaseSensitiveParameterNames);
1024 tony 209 {$IFDEF IBXQUERYSTATS}
1025     FStatement.EnableStatistics(true);
1026     {$ENDIF}
1027     FMetaData := FStatement.GetMetaData;
1028     FSQLParams := FStatement.GetSQLParams;
1029     FStatement.SetRetainInterfaces(true);
1030     if not (csDesigning in ComponentState) then
1031     MonitorHook.SQLPrepare(Self);
1032     end;
1033    
1034     function TIBSQL.GetUniqueRelationName: String;
1035     begin
1036     if Prepared and (GetSQLStatementType = SQLSelect) then
1037     result := FMetaData.GetUniqueRelationName
1038     else
1039     result := '';
1040     end;
1041    
1042 tony 345 function TIBSQL.HasBatchMode: boolean;
1043     begin
1044     CheckValidStatement;
1045     Result := Statement.HasBatchMode;
1046     end;
1047    
1048     function TIBSQL.IsInBatchMode: boolean;
1049     begin
1050     CheckValidStatement;
1051     Result := Statement.IsInBatchMode;
1052     end;
1053    
1054     procedure TIBSQL.AddToBatch;
1055     begin
1056     CheckValidStatement;
1057     Statement.AddToBatch;
1058     end;
1059    
1060     function TIBSQL.ExecuteBatch: IBatchCompletion;
1061     begin
1062     CheckValidStatement;
1063     Result := Statement.ExecuteBatch;
1064     end;
1065    
1066     procedure TIBSQL.CancelBatch;
1067     begin
1068     CheckValidStatement;
1069     Statement.CancelBatch;
1070     end;
1071    
1072     function TIBSQL.GetBatchCompletion: IBatchCompletion;
1073     begin
1074     CheckValidStatement;
1075     Result := Statement.GetBatchCompletion;
1076     end;
1077    
1078     function TIBSQL.GetBatchRowLimit: integer;
1079     begin
1080     CheckValidStatement;
1081     Result := Statement.GetBatchRowLimit;
1082     end;
1083    
1084     procedure TIBSQL.SetBatchRowLimit(aLimit: integer);
1085     begin
1086     CheckValidStatement;
1087     Statement.SetBatchRowLimit(aLimit);
1088     end;
1089    
1090 tony 209 procedure TIBSQL.SetSQL(Value: TStrings);
1091     begin
1092     if FSQL.Text <> Value.Text then
1093     begin
1094     FSQL.BeginUpdate;
1095     try
1096     FSQL.Assign(Value);
1097     finally
1098     FSQL.EndUpdate;
1099     end;
1100     end;
1101     end;
1102    
1103     procedure TIBSQL.SetTransaction(Value: TIBTransaction);
1104     begin
1105     if FBase.Transaction = Value then Exit;
1106     FreeHandle;
1107     FBase.Transaction := Value;
1108     end;
1109    
1110     procedure TIBSQL.SQLChanging(Sender: TObject);
1111     begin
1112     if Assigned(OnSQLChanging) then
1113     OnSQLChanging(Self);
1114    
1115     FreeHandle;
1116     end;
1117    
1118     procedure TIBSQL.SQLChanged(Sender: TObject);
1119     begin
1120     if assigned(OnSQLChanged) then
1121     OnSQLChanged(self);
1122     end;
1123    
1124     procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
1125     Action: TTransactionAction);
1126     begin
1127     if not (Owner is TIBCustomDataSet) then
1128     FreeHandle;
1129     end;
1130    
1131     end.