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

# 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 FCaseSensitiveParameterNames: boolean;
162 FMetaData: IMetaData;
163 FScrollable: boolean;
164 FSQLParams: ISQLParams;
165 FStatement: IStatement;
166 FOnSQLChanged: TNotifyEvent;
167 FUniqueParamNames: Boolean;
168 function GetBOF: Boolean;
169 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 function GetRowsAffected: Int64;
192 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 function HasField(FieldName: String): boolean; {Note: case sensitive match}
211 function HasScollableCursors: boolean;
212 function FieldByName(FieldName: String): ISQLData;
213 function ParamByName(ParamName: String): ISQLParam;
214 procedure FreeHandle;
215 function Next: boolean;
216 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 procedure Prepare;
223 function GetUniqueRelationName: String;
224 property Bof: Boolean read GetBOF;
225 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 property RowsAffected: Int64 read GetRowsAffected;
236 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
237 property UniqueRelationName: String read GetUniqueRelationName;
238 property Statement: IStatement read FStatement;
239 property MetaData: IMetaData read FMetaData;
240 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 published
251 property Database: TIBDatabase read GetDatabase write SetDatabase;
252 property CaseSensitiveParameterNames: boolean read FCaseSensitiveParameterNames
253 write FCaseSensitiveParameterNames;
254 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 property Scrollable: boolean read FScrollable write FScrollable;
262 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 Variants, IBSQLMonitor, IBMessages, IBCustomDataSet;
273
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 function TIBSQL.GetBOF: Boolean;
686 begin
687 Result := (FResultSet = nil) or FResultSet.IsBof;
688 end;
689
690 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 FResultSet := FStatement.OpenCursor(Scrollable);
739 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
754 {$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 var i: integer;
768 begin
769 if MetaData = nil then
770 IBError(ibxeNoFieldAccess,[nil]);
771
772 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 end;
782
783 function TIBSQL.HasScollableCursors: boolean;
784 begin
785 Result := Database.Attachment.HasScollableCursors;
786 end;
787
788 function TIBSQL.GetEOF: Boolean;
789 begin
790 result := (FResultSet = nil) or FResultSet.IsEof;
791 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 Result := FetchNext;
836 end;
837
838 function TIBSQL.FetchNext: boolean;
839 begin
840 result := false;
841 if not EOF then
842 begin
843 CheckOpen;
844 try
845 Result := FResultSet.FetchNext;
846 except
847 Close;
848 raise;
849 end;
850
851 if Result and not Scrollable then
852 Inc(FRecordCount);
853
854 if not (csDesigning in ComponentState) then
855 MonitorHook.SQLFetch(Self);
856 end;
857 end;
858
859 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 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 function TIBSQL.GetRowsAffected: Int64;
971 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 GenerateParamNames,
1023 CaseSensitiveParameterNames);
1024 {$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 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 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.