ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBSQL.pas
Revision: 229
Committed: Tue Apr 10 13:32:36 2018 UTC (5 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 25758 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { The Original Code was created by InterBase Software Corporation }
22 { and its successors. }
23 { Portions created by Inprise Corporation are Copyright (C) Inprise }
24 { Corporation. All Rights Reserved. }
25 { Contributor(s): Jeff Overcash }
26 { }
27 { IBX For Lazarus (Firebird Express) }
28 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 { Portions created by MWA Software are copyright McCallum Whyman }
30 { Associates Ltd 2011 - 2014 }
31 { }
32 {************************************************************************}
33
34 unit IBSQL;
35
36 {$Mode Delphi}
37
38 {$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 FMetaData: IMetaData;
162 FSQLParams: ISQLParams;
163 FStatement: IStatement;
164 FOnSQLChanged: TNotifyEvent;
165 FUniqueParamNames: Boolean;
166 FBOF: boolean;
167 FEOF: boolean;
168 function GetFieldCount: integer;
169 function GetOpen: Boolean;
170 function GetPrepared: Boolean;
171 function GetSQLStatementType: TIBSQLStatementTypes;
172 procedure SetUniqueParamNames(AValue: Boolean);
173 protected
174 FBase: TIBBase;
175 FGoToFirstRecordOnExecute: boolean; { Automatically position record on first record after executing }
176 FRecordCount: Integer; { How many records have been read so far? }
177 FOnSQLChanging: TNotifyEvent; { Call this when the SQL is changing }
178 FSQL: TStrings; { SQL Query (by user) }
179 FParamCheck: Boolean; { Check for parameters? (just like TQuery) }
180 FResults: IResults; {Single row results from exec}
181 FResultSet: IResultSet; {Multi-row results from open cursor}
182 FGenerateParamNames: Boolean; { Auto generate param names ?}
183 procedure DoBeforeDatabaseDisconnect(Sender: TObject);
184 function GetDatabase: TIBDatabase;
185 function GetEOF: Boolean;
186 function GetFields(const Idx: Integer): ISQLData;
187 function GetFieldIndex(FieldName: String): Integer;
188 function GetPlan: String;
189 function GetRecordCount: Integer;
190 function GetRowsAffected: Integer;
191 function GetSQLParams: ISQLParams;
192 function GetTransaction: TIBTransaction;
193 procedure SetDatabase(Value: TIBDatabase);
194 procedure SetSQL(Value: TStrings);
195 procedure SetTransaction(Value: TIBTransaction);
196 procedure SQLChanging(Sender: TObject);
197 procedure SQLChanged(Sender: TObject);
198 procedure BeforeTransactionEnd(Sender: TObject; Action: TTransactionAction);
199 public
200 constructor Create(AOwner: TComponent); override;
201 destructor Destroy; override;
202 procedure BatchInput(InputObject: TIBBatchInput);
203 procedure BatchOutput(OutputObject: TIBBatchOutput);
204 procedure CheckClosed; { raise error if query is not closed. }
205 procedure CheckOpen; { raise error if query is not open.}
206 procedure CheckValidStatement; { raise error if statement is invalid.}
207 procedure Close;
208 procedure ExecQuery;
209 function HasField(FieldName: String): boolean; {Note: case sensitive match}
210 function FieldByName(FieldName: String): ISQLData;
211 function ParamByName(ParamName: String): ISQLParam;
212 procedure FreeHandle;
213 function Next: boolean;
214 procedure Prepare;
215 function GetUniqueRelationName: String;
216 property Bof: Boolean read FBOF;
217 property Eof: Boolean read GetEOF;
218 property Current: IResults read FResults;
219 property Fields[const Idx: Integer]: ISQLData read GetFields; default;
220 property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
221 property FieldCount: integer read GetFieldCount;
222 property Open: Boolean read GetOpen;
223 property Params: ISQLParams read GetSQLParams;
224 property Plan: String read GetPlan;
225 property Prepared: Boolean read GetPrepared;
226 property RecordCount: Integer read GetRecordCount;
227 property RowsAffected: Integer read GetRowsAffected;
228 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
229 property UniqueRelationName: String read GetUniqueRelationName;
230 property Statement: IStatement read FStatement;
231 property MetaData: IMetaData read FMetaData;
232 published
233 property Database: TIBDatabase read GetDatabase write SetDatabase;
234 property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
235 property UniqueParamNames: Boolean read FUniqueParamNames write SetUniqueParamNames;
236 property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
237 write FGoToFirstRecordOnExecute
238 default True;
239 property ParamCheck: Boolean read FParamCheck write FParamCheck;
240 property SQL: TStrings read FSQL write SetSQL;
241 property Transaction: TIBTransaction read GetTransaction write SetTransaction;
242 property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
243 property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
244 end;
245
246 procedure IBAlloc(var P; OldSize, NewSize: Integer);
247
248 implementation
249
250 uses
251 Variants, IBSQLMonitor, FBMessages, IBCustomDataSet;
252
253 procedure IBAlloc(var P; OldSize, NewSize: Integer);
254 var
255 i: Integer;
256 begin
257 ReallocMem(Pointer(P), NewSize);
258 for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
259 end;
260
261 { TIBOutputDelimitedFile }
262
263 destructor TIBOutputDelimitedFile.Destroy;
264 begin
265 {$IFDEF UNIX}
266 if FHandle <> -1 then
267 fpclose(FHandle);
268 {$ELSE}
269 if FHandle <> 0 then
270 begin
271 FlushFileBuffers(FHandle);
272 CloseHandle(FHandle);
273 end;
274 {$ENDIF}
275 inherited Destroy;
276 end;
277
278 procedure TIBOutputDelimitedFile.ReadyFile;
279 var
280 i: Integer;
281 {$IFDEF UNIX}
282 BytesWritten: cint;
283 {$ELSE}
284 BytesWritten: DWORD;
285 {$ENDIF}
286 st: string;
287 begin
288 if FColDelimiter = '' then
289 FColDelimiter := TAB;
290 if FRowDelimiter = '' then
291 FRowDelimiter := CRLF;
292 {$IFDEF UNIX}
293 FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
294 {$ELSE}
295 FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
296 FILE_ATTRIBUTE_NORMAL, 0);
297 if FHandle = INVALID_HANDLE_VALUE then
298 FHandle := 0;
299 {$ENDIF}
300 if FOutputTitles then
301 begin
302 for i := 0 to Columns.Count - 1 do
303 if i = 0 then
304 st := Columns[i].GetAliasname
305 else
306 st := st + FColDelimiter + Columns[i].GetAliasname;
307 st := st + FRowDelimiter;
308 {$IFDEF UNIX}
309 if FHandle <> -1 then
310 BytesWritten := FpWrite(FHandle,st[1],Length(st));
311 if BytesWritten = -1 then
312 raise Exception.Create('File Write Error');
313 {$ELSE}
314 WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
315 {$ENDIF}
316 end;
317 end;
318
319 function TIBOutputDelimitedFile.WriteColumns: Boolean;
320 var
321 i: Integer;
322 {$IFDEF UNIX}
323 BytesWritten: cint;
324 {$ELSE}
325 BytesWritten: DWORD;
326 {$ENDIF}
327 st: string;
328 begin
329 result := False;
330 {$IFDEF UNIX}
331 if FHandle <> -1 then
332 {$ELSE}
333 if FHandle <> 0 then
334 {$ENDIF}
335 begin
336 st := '';
337 for i := 0 to Columns.Count - 1 do
338 begin
339 if i > 0 then
340 st := st + FColDelimiter;
341 st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
342 end;
343 st := st + FRowDelimiter;
344 {$IFDEF UNIX}
345 BytesWritten := FpWrite(FHandle,st[1],Length(st));
346 {$ELSE}
347 WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
348 {$ENDIF}
349 if BytesWritten = DWORD(Length(st)) then
350 result := True;
351 end
352 end;
353
354 { TIBInputDelimitedFile }
355
356 destructor TIBInputDelimitedFile.Destroy;
357 begin
358 FFile.Free;
359 inherited Destroy;
360 end;
361
362 function TIBInputDelimitedFile.GetColumn(var Col: string): Integer;
363 var
364 c: Char;
365 BytesRead: Integer;
366
367 procedure ReadInput;
368 begin
369 if FLookAhead <> NULL_TERMINATOR then
370 begin
371 c := FLookAhead;
372 BytesRead := 1;
373 FLookAhead := NULL_TERMINATOR;
374 end else
375 BytesRead := FFile.Read(c, 1);
376 end;
377
378 procedure CheckCRLF(Delimiter: string);
379 begin
380 if (c = CR) and (Pos(LF, Delimiter) > 0) then {mbcs ok}
381 begin
382 BytesRead := FFile.Read(c, 1);
383 if (BytesRead = 1) and (c <> #10) then
384 FLookAhead := c
385 end;
386 end;
387
388 begin
389 Col := '';
390 result := 0;
391 ReadInput;
392 while BytesRead <> 0 do begin
393 if Pos(c, FColDelimiter) > 0 then {mbcs ok}
394 begin
395 CheckCRLF(FColDelimiter);
396 result := 1;
397 break;
398 end else if Pos(c, FRowDelimiter) > 0 then {mbcs ok}
399 begin
400 CheckCRLF(FRowDelimiter);
401 result := 2;
402 break;
403 end else
404 Col := Col + c;
405 ReadInput;
406 end;
407 end;
408
409 function TIBInputDelimitedFile.ReadParameters: Boolean;
410 var
411 i, curcol: Integer;
412 Col: string;
413 begin
414 result := False;
415 if not FEOF then begin
416 curcol := 0;
417 repeat
418 i := GetColumn(Col);
419 if (i = 0) then
420 FEOF := True;
421 if (curcol < Params.Count) then
422 begin
423 try
424 if (Col = '') and
425 (ReadBlanksAsNull) then
426 Params[curcol].IsNull := True
427 else
428 Params[curcol].AsString := Col;
429 Inc(curcol);
430 except
431 on E: Exception do begin
432 if not (FEOF and (curcol = Params.Count)) then
433 raise;
434 end;
435 end;
436 end;
437 until (FEOF) or (i = 2);
438 result := ((FEOF) and (curcol = Params.Count)) or
439 (not FEOF);
440 end;
441 end;
442
443 procedure TIBInputDelimitedFile.ReadyFile;
444 begin
445 if FColDelimiter = '' then
446 FColDelimiter := TAB;
447 if FRowDelimiter = '' then
448 FRowDelimiter := CRLF;
449 FLookAhead := NULL_TERMINATOR;
450 FEOF := False;
451 if FFile <> nil then
452 FFile.Free;
453 FFile := TFileStream.Create(FFilename, fmOpenRead or fmShareDenyWrite);
454 if FSkipTitles then
455 ReadParameters;
456 end;
457
458 { TIBOutputRawFile }
459 destructor TIBOutputRawFile.Destroy;
460 begin
461 {$IFDEF UNIX}
462 if FHandle <> -1 then
463 fpclose(FHandle);
464 {$ELSE}
465 if FHandle <> 0 then
466 begin
467 FlushFileBuffers(FHandle);
468 CloseHandle(FHandle);
469 end;
470 {$ENDIF}
471 inherited Destroy;
472 end;
473
474 procedure TIBOutputRawFile.ReadyFile;
475 begin
476 {$IFDEF UNIX}
477 FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
478 {$ELSE}
479 FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
480 FILE_ATTRIBUTE_NORMAL, 0);
481 if FHandle = INVALID_HANDLE_VALUE then
482 FHandle := 0;
483 {$ENDIF}
484 end;
485
486 function TIBOutputRawFile.WriteColumns: Boolean;
487 var
488 i: Integer;
489 BytesWritten: DWord;
490 begin
491 result := False;
492 if FHandle <> 0 then
493 begin
494 for i := 0 to Columns.Count - 1 do
495 begin
496 {$IFDEF UNIX}
497 BytesWritten := FpWrite(FHandle,Columns[i].GetAsPointer^, Columns[i].GetSize);
498 {$ELSE}
499 WriteFile(FHandle, Columns[i].GetAsPointer^, Columns[i].GetSize,
500 BytesWritten, nil);
501 {$ENDIF}
502 if BytesWritten <> DWORD(Columns[i].GetSize) then
503 exit;
504 end;
505 result := True;
506 end;
507 end;
508
509 { TIBInputRawFile }
510 destructor TIBInputRawFile.Destroy;
511 begin
512 {$IFDEF UNIX}
513 if FHandle <> -1 then
514 fpclose(FHandle);
515 {$ELSE}
516 if FHandle <> 0 then
517 CloseHandle(FHandle);
518 {$ENDIF}
519 inherited Destroy;
520 end;
521
522 function TIBInputRawFile.ReadParameters: Boolean;
523 var
524 i: Integer;
525 BytesRead: DWord;
526 begin
527 result := False;
528 {$IFDEF UNIX}
529 if FHandle <> -1 then
530 {$ELSE}
531 if FHandle <> 0 then
532 {$ENDIF}
533 begin
534 for i := 0 to Params.Count - 1 do
535 begin
536 {$IFDEF UNIX}
537 BytesRead := FpRead(FHandle,Params[i].GetAsPointer^,Params[i].GetSize);
538 {$ELSE}
539 ReadFile(FHandle, Params[i].GetAsPointer^, Params[i].GetSize,
540 BytesRead, nil);
541 {$ENDIF}
542 if BytesRead <> DWORD(Params[i].GetSize) then
543 exit;
544 end;
545 result := True;
546 end;
547 end;
548
549 procedure TIBInputRawFile.ReadyFile;
550 begin
551 {$IFDEF UNIX}
552 if FHandle <> -1 then
553 fpclose(FHandle);
554 FHandle := FpOpen(Filename,O_RdOnly);
555 if FHandle = -1 then
556 raise Exception.CreateFmt('Unable to open file %s',[Filename]);
557 {$ELSE}
558 if FHandle <> 0 then
559 CloseHandle(FHandle);
560 FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
561 FILE_FLAG_SEQUENTIAL_SCAN, 0);
562 if FHandle = INVALID_HANDLE_VALUE then
563 FHandle := 0;
564 {$ENDIF}
565 end;
566
567 { TIBSQL }
568 constructor TIBSQL.Create(AOwner: TComponent);
569 begin
570 inherited Create(AOwner);
571 FGenerateParamNames := False;
572 FGoToFirstRecordOnExecute := True;
573 FBase := TIBBase.Create(Self);
574 FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
575 FBase.BeforeTransactionEnd := BeforeTransactionEnd;
576 FRecordCount := 0;
577 FSQL := TStringList.Create;
578 TStringList(FSQL).OnChanging := SQLChanging;
579 TStringList(FSQL).OnChange := SQLChanged;
580 FParamCheck := True;
581 if AOwner is TIBDatabase then
582 Database := TIBDatabase(AOwner)
583 else
584 if AOwner is TIBTransaction then
585 Transaction := TIBTransaction(AOwner);
586 end;
587
588 destructor TIBSQL.Destroy;
589 begin
590 FreeHandle;
591 FSQL.Free;
592 FBase.Free;
593 inherited Destroy;
594 end;
595
596 procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
597 begin
598 if not Prepared then
599 Prepare;
600 InputObject.FParams := Self.GetSQLParams;
601 InputObject.ReadyFile;
602 if GetSQLStatementType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
603 while InputObject.ReadParameters do
604 ExecQuery;
605 end;
606
607 procedure TIBSQL.BatchOutput(OutputObject: TIBBatchOutput);
608 begin
609 CheckClosed;
610 if not Prepared then
611 Prepare;
612 if GetSQLStatementType = SQLSelect then begin
613 try
614 ExecQuery;
615 OutputObject.FColumns := Self.FResults;
616 OutputObject.ReadyFile;
617 if not FGoToFirstRecordOnExecute then
618 Next;
619 while (not Eof) and (OutputObject.WriteColumns) do
620 Next;
621 finally
622 Close;
623 end;
624 end;
625 end;
626
627 procedure TIBSQL.CheckClosed;
628 begin
629 if FResultSet <> nil then IBError(ibxeSQLOpen, [nil]);
630 end;
631
632 procedure TIBSQL.CheckOpen;
633 begin
634 if FResultSet = nil then IBError(ibxeSQLClosed, [nil]);
635 end;
636
637 procedure TIBSQL.CheckValidStatement;
638 begin
639 FBase.CheckTransaction;
640 if (FStatement = nil) then
641 IBError(ibxeInvalidStatementHandle, [nil]);
642 end;
643
644 procedure TIBSQL.Close;
645 begin
646 if FResults <> nil then
647 FResults.SetRetainInterfaces(false);
648 FResultSet := nil;
649 FResults := nil;
650 FBOF := false;
651 FEOF := false;
652 FRecordCount := 0;
653 end;
654
655 function TIBSQL.GetFieldCount: integer;
656 begin
657 if FResults <> nil then
658 Result := FResults.GetCount
659 else
660 if FMetaData <> nil then
661 Result := FMetaData.GetCount
662 else
663 Result := 0;
664 end;
665
666 function TIBSQL.GetOpen: Boolean;
667 begin
668 Result := FResultSet <> nil;
669 end;
670
671 function TIBSQL.GetPrepared: Boolean;
672 begin
673 Result := (FStatement <> nil) and FStatement.IsPrepared;
674 end;
675
676 function TIBSQL.GetSQLStatementType: TIBSQLStatementTypes;
677 begin
678 if FStatement = nil then
679 Result := SQLUnknown
680 else
681 Result := FStatement.GetSQLStatementType;
682 end;
683
684 procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
685 begin
686 if FUniqueParamNames = AValue then Exit;
687 FreeHandle;
688 FUniqueParamNames := AValue;
689 end;
690
691 procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
692 begin
693 FreeHandle;
694 end;
695
696 procedure TIBSQL.ExecQuery;
697 {$IFDEF IBXQUERYSTATS}
698 var
699 stats: TPerfCounters;
700 {$ENDIF}
701 {$IFDEF IBXQUERYTIME}
702 var
703 tmsecs: comp;
704 {$ENDIF}
705 begin
706 CheckClosed;
707 if not Prepared then Prepare;
708 CheckValidStatement;
709 {$IFDEF IBXQUERYTIME}
710 tmsecs := TimeStampToMSecs(DateTimeToTimeStamp(Now));
711 {$ENDIF}
712 if SQLStatementType = SQLSelect then
713 begin
714 FResultSet := FStatement.OpenCursor;
715 FResults := FResultSet;
716 FResults.SetRetainInterfaces(true);
717 FBOF := True;
718 FEOF := False;
719 FRecordCount := 0;
720 if not (csDesigning in ComponentState) then
721 MonitorHook.SQLExecute(Self);
722 if FGoToFirstRecordOnExecute then
723 Next;
724 end
725 else
726 begin
727 FResults := FStatement.Execute;
728 if not (csDesigning in ComponentState) then
729 MonitorHook.SQLExecute(Self);
730 end;
731 {$IFDEF IBXQUERYTIME}
732 writeln('Executing ',FStatement.GetSQLText,
733 ' Response time= ',Format('%f msecs',[TimeStampToMSecs(DateTimeToTimeStamp(Now)) - tmsecs]));
734 {$ENDIF}
735 {$IFDEF IBXQUERYSTATS}
736 if FStatement.GetPerfStatistics(stats) then
737 writeln('Executing ',FStatement.GetSQLText,
738 ' Elapsed time= ', FormatFloat('#0.000',stats[psRealTime]/1000),' sec');
739 {$ENDIF}
740 FBase.DoAfterExecQuery(self);
741 end;
742
743 function TIBSQL.HasField(FieldName: String): boolean;
744 var i: integer;
745 begin
746 if MetaData = nil then
747 IBError(ibxeNoFieldAccess,[nil]);
748
749 Result := false;
750 for i := 0 to MetaData.Count - 1 do
751 begin
752 if MetaData.ColMetaData[i].Name = FieldName then
753 begin
754 Result := true;
755 Exit;
756 end;
757 end;
758 end;
759
760 function TIBSQL.GetEOF: Boolean;
761 begin
762 result := FEOF or (FResultSet = nil);
763 end;
764
765 function TIBSQL.FieldByName(FieldName: String): ISQLData;
766 begin
767 if FResults = nil then
768 IBError(ibxeNoFieldAccess,[nil]);
769
770 Result := FResults.ByName(FieldName);
771
772 if Result = nil then
773 IBError(ibxeFieldNotFound, [FieldName]);
774 end;
775
776 function TIBSQL.ParamByName(ParamName: String): ISQLParam;
777 begin
778 Result := Params.ByName(ParamName);
779 end;
780
781 function TIBSQL.GetFields(const Idx: Integer): ISQLData;
782 begin
783 if FResults = nil then
784 IBError(ibxeNoFieldAccess,[nil]);
785
786 if (Idx < 0) or (Idx >= FResults.GetCount) then
787 IBError(ibxeFieldNotFound, [IntToStr(Idx)]);
788 result := FResults[Idx];
789 end;
790
791 function TIBSQL.GetFieldIndex(FieldName: String): Integer;
792 var Field: IColumnMetaData;
793 begin
794 if FMetaData = nil then
795 IBError(ibxeNoFieldAccess,[nil]);
796
797 Field := FMetaData.ByName(FieldName);
798
799 if Field = nil then
800 result := -1
801 else
802 result := Field.GetIndex;
803 end;
804
805 function TIBSQL.Next: boolean;
806 begin
807 result := false;
808 if not FEOF then
809 begin
810 CheckOpen;
811 try
812 Result := FResultSet.FetchNext;
813 except
814 Close;
815 raise;
816 end;
817
818 if Result then
819 begin
820 Inc(FRecordCount);
821 FBOF := False;
822 end
823 else
824 FEOF := true;
825
826 if not (csDesigning in ComponentState) then
827 MonitorHook.SQLFetch(Self);
828 end;
829 end;
830
831 procedure TIBSQL.FreeHandle;
832 begin
833 if FStatement <> nil then
834 FStatement.SetRetainInterfaces(false);
835 Close;
836 FStatement := nil;
837 FResults := nil;
838 FResultSet := nil;
839 FMetaData := nil;
840 FSQLParams := nil;
841 end;
842
843 function TIBSQL.GetDatabase: TIBDatabase;
844 begin
845 result := FBase.Database;
846 end;
847
848 function TIBSQL.GetPlan: String;
849 begin
850 if (not Prepared) or
851 (not (GetSQLStatementType in [SQLSelect, SQLSelectForUpdate,
852 {TODO: SQLExecProcedure, }
853 SQLUpdate, SQLDelete])) then
854 result := ''
855 else
856 Result := FStatement.GetPlan;
857 end;
858
859 function TIBSQL.GetRecordCount: Integer;
860 begin
861 Result := FRecordCount;
862 end;
863
864 function TIBSQL.GetRowsAffected: Integer;
865 var
866 SelectCount, InsertCount, UpdateCount, DeleteCount: integer;
867 begin
868 if not Prepared then
869 Result := -1
870 else
871 begin
872 FStatement.GetRowsAffected(SelectCount, InsertCount, UpdateCount, DeleteCount);
873 Result := InsertCount + UpdateCount + DeleteCount;
874 end;
875 end;
876
877 function TIBSQL.GetSQLParams: ISQLParams;
878 begin
879 if not Prepared then
880 Prepare;
881 result := Statement.SQLParams;
882 end;
883
884 function TIBSQL.GetTransaction: TIBTransaction;
885 begin
886 result := FBase.Transaction;
887 end;
888
889 procedure TIBSQL.SetDatabase(Value: TIBDatabase);
890 begin
891 if Value = FBase.Database then Exit;
892 FBase.Database := Value;
893 FreeHandle;
894 end;
895
896 procedure TIBSQL.Prepare;
897 begin
898 CheckClosed;
899 FBase.CheckDatabase;
900 FBase.CheckTransaction;
901 Close;
902 if Prepared then
903 exit;
904 if (FSQL.Text = '') then
905 IBError(ibxeEmptyQuery, [nil]);
906
907 if FStatement <> nil then
908 FStatement.Prepare(Transaction.TransactionIntf)
909 else
910 if not ParamCheck then
911 FStatement := Database.Attachment.Prepare(Transaction.TransactionIntf,SQL.Text)
912 else
913 FStatement := Database.Attachment.PrepareWithNamedParameters(
914 Transaction.TransactionIntf,
915 SQL.Text,
916 GenerateParamNames);
917 {$IFDEF IBXQUERYSTATS}
918 FStatement.EnableStatistics(true);
919 {$ENDIF}
920 FMetaData := FStatement.GetMetaData;
921 FSQLParams := FStatement.GetSQLParams;
922 FStatement.SetRetainInterfaces(true);
923 if not (csDesigning in ComponentState) then
924 MonitorHook.SQLPrepare(Self);
925 end;
926
927 function TIBSQL.GetUniqueRelationName: String;
928 begin
929 if Prepared and (GetSQLStatementType = SQLSelect) then
930 result := FMetaData.GetUniqueRelationName
931 else
932 result := '';
933 end;
934
935 procedure TIBSQL.SetSQL(Value: TStrings);
936 begin
937 if FSQL.Text <> Value.Text then
938 begin
939 FSQL.BeginUpdate;
940 try
941 FSQL.Assign(Value);
942 finally
943 FSQL.EndUpdate;
944 end;
945 end;
946 end;
947
948 procedure TIBSQL.SetTransaction(Value: TIBTransaction);
949 begin
950 if FBase.Transaction = Value then Exit;
951 FreeHandle;
952 FBase.Transaction := Value;
953 end;
954
955 procedure TIBSQL.SQLChanging(Sender: TObject);
956 begin
957 if Assigned(OnSQLChanging) then
958 OnSQLChanging(Self);
959
960 FreeHandle;
961 end;
962
963 procedure TIBSQL.SQLChanged(Sender: TObject);
964 begin
965 if assigned(OnSQLChanged) then
966 OnSQLChanged(self);
967 end;
968
969 procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
970 Action: TTransactionAction);
971 begin
972 if not (Owner is TIBCustomDataSet) then
973 FreeHandle;
974 end;
975
976 end.