ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBQuery.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 14595 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 - 2018 }
31 { }
32 {************************************************************************}
33
34 unit IBQuery;
35
36 interface
37
38 {$Mode Delphi}
39
40 uses
41 {$IFDEF WINDOWS }
42 Windows,
43 {$ELSE}
44 unix,
45 {$ENDIF}
46 SysUtils, Classes, Db, IB, IBCustomDataSet, IBSQL;
47
48 type
49
50 { TIBQuery }
51
52 TIBQuery = class(TIBParserDataSet)
53 private
54 FSQL: TStrings;
55 FPrepared: Boolean;
56 FParams: TParams;
57 FText: string;
58 FSQLUpdating: boolean;
59 FInQueryChanged: boolean;
60 function GetRowsAffected: Integer;
61 procedure PrepareSQL;
62 procedure QueryChanged(Sender: TObject);
63 procedure ReadParamData(Reader: TReader);
64 procedure SetQuery(Value: TStrings);
65 procedure SetParamsList(Value: TParams);
66 procedure SetParams;
67 procedure SetParamsFromCursor;
68 procedure SetPrepared(Value: Boolean);
69 procedure SetPrepare(Value: Boolean);
70 procedure WriteParamData(Writer: TWriter);
71 function GetStmtHandle: IStatement;
72 procedure UpdateSQL;
73
74 protected
75 { IProviderSupport }
76 (* procedure PSExecute; override;
77 function PSGetParams: TParams; override;
78 function PSGetTableName: string; override;
79 procedure PSSetCommandText(const CommandText: string); override;
80 procedure PSSetParams(AParams: TParams); override; *)
81
82 procedure DefineProperties(Filer: TFiler); override;
83 procedure InitFieldDefs; override;
84 procedure InternalOpen; override;
85 procedure Disconnect; override;
86 function GetParamsCount: Word;
87 function GenerateQueryForLiveUpdate : Boolean;
88 procedure SetFiltered(Value: Boolean); override;
89 procedure SQLChanged(Sender: TObject); override;
90 procedure SQLChanging(Sender: TObject); override;
91
92 public
93 constructor Create(AOwner: TComponent); override;
94 destructor Destroy; override;
95 procedure BatchInput(InputObject: TIBBatchInput);
96 procedure BatchOutput(OutputObject: TIBBatchOutput);
97 procedure ExecSQL;
98 procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
99 function ParamByName(const Value: string): TParam;
100 procedure Prepare;
101 procedure UnPrepare;
102 procedure ResetParser; override;
103 property Prepared: Boolean read FPrepared write SetPrepare;
104 property ParamCount: Word read GetParamsCount;
105 property StmtHandle: IStatement read GetStmtHandle;
106 property StatementType;
107 property Text: string read FText;
108 property RowsAffected: Integer read GetRowsAffected;
109 // property Params: TParams read FParams write SetParamsList;
110 property BaseSQLSelect;
111
112 published
113 property Active;
114 property AutoCommit;
115 property BufferChunks;
116 property CachedUpdates;
117 property DataSource read GetDataSource write SetDataSource;
118 property EnableStatistics;
119 property GenerateParamNames;
120 // property Constraints stored ConstraintsStored;
121 property GeneratorField;
122 property MasterDetailDelay;
123 property ParamCheck;
124 property SQL: TStrings read FSQL write SetQuery;
125 property Params: TParams read FParams write SetParamsList;
126 property UniDirectional default False;
127 property UpdateObject;
128 property Filtered;
129 property DataSetCloseAction;
130
131 property BeforeDatabaseDisconnect;
132 property AfterDatabaseDisconnect;
133 property DatabaseFree;
134 property BeforeTransactionEnd;
135 property AfterTransactionEnd;
136 property TransactionFree;
137 property OnFilterRecord;
138 property OnValidatePost;
139 property OnDeleteReturning;
140 end;
141
142 implementation
143
144 uses FBMessages;
145
146 { TIBQuery }
147
148 constructor TIBQuery.Create(AOwner: TComponent);
149 begin
150 inherited Create(AOwner);
151 FSQL := TStringList.Create;
152 TStringList(SQL).OnChange := QueryChanged;
153 FParams := TParams.Create(Self);
154 ParamCheck := True;
155 end;
156
157 destructor TIBQuery.Destroy;
158 begin
159 Destroying;
160 Disconnect;
161 SQL.Free;
162 FParams.Free;
163 inherited Destroy;
164 end;
165
166 procedure TIBQuery.InitFieldDefs;
167 begin
168 inherited InitFieldDefs;
169 end;
170
171 procedure TIBQuery.InternalOpen;
172 begin
173 ActivateConnection();
174 ActivateTransaction;
175 QSelect.GenerateParamNames := GenerateParamNames;
176 SetPrepared(True);
177 if DataSource <> nil then
178 SetParamsFromCursor;
179 SetParams;
180 inherited InternalOpen;
181 end;
182
183 procedure TIBQuery.Disconnect;
184 begin
185 Close;
186 UnPrepare;
187 end;
188
189 procedure TIBQuery.SetPrepare(Value: Boolean);
190 begin
191 if Value then
192 Prepare
193 else
194 UnPrepare;
195 end;
196
197 procedure TIBQuery.Prepare;
198 begin
199 SetPrepared(True);
200 end;
201
202 procedure TIBQuery.UnPrepare;
203 begin
204 SetPrepared(False);
205 end;
206
207 procedure TIBQuery.ResetParser;
208 begin
209 inherited ResetParser;
210 UpdateSQL;
211 end;
212
213 procedure TIBQuery.SetQuery(Value: TStrings);
214 begin
215 if SQL.Text <> Value.Text then
216 begin
217 Disconnect;
218 SQL.BeginUpdate;
219 try
220 SQL.Assign(Value);
221 finally
222 SQL.EndUpdate;
223 end;
224 end;
225 end;
226
227 procedure TIBQuery.QueryChanged(Sender: TObject);
228 begin
229 if FInQueryChanged then Exit;
230 FInQueryChanged := true;
231 try
232 if not (csReading in ComponentState) then
233 begin
234 Disconnect;
235 if csDesigning in ComponentState then
236 FText := FParams.ParseSQL(SQL.Text, true)
237 else
238 FText := SQL.Text;
239 DataEvent(dePropertyChange, 0);
240 end else
241 FText := FParams.ParseSQL(SQL.Text, true);
242
243 if not FSQLUpdating then
244 begin
245 Prepared := false;
246 SelectSQL.Assign(SQL);
247 end;
248 finally
249 FInQueryChanged := false;
250 end;
251 end;
252
253 procedure TIBQuery.SetParamsList(Value: TParams);
254 begin
255 FParams.AssignValues(Value);
256 end;
257
258 function TIBQuery.GetParamsCount: Word;
259 begin
260 Result := FParams.Count;
261 end;
262
263 procedure TIBQuery.DefineProperties(Filer: TFiler);
264
265 function WriteData: Boolean;
266 begin
267 {The following results in a stream read error with nested frames. Hence commented out until
268 someone fixes the LCL }
269 { if Filer.Ancestor <> nil then
270 Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else}
271 Result := FParams.Count > 0;
272 end;
273
274 begin
275 inherited DefineProperties(Filer);
276 Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData); {do not localize}
277 end;
278
279
280 procedure TIBQuery.ReadParamData(Reader: TReader);
281 begin
282 FParams.Clear;
283 Reader.ReadValue;
284 Reader.ReadCollection(FParams);
285 end;
286
287 procedure TIBQuery.WriteParamData(Writer: TWriter);
288 begin
289 Writer.WriteCollection(Params);
290 end;
291
292 procedure TIBQuery.SetPrepared(Value: Boolean);
293 begin
294 CheckDatasetClosed;
295 if Value <> Prepared then
296 begin
297 if Value then
298 begin
299 if Length(Text) > 1 then PrepareSQL
300 else IBError(ibxeEmptySQLStatement, [nil]);
301 end
302 else
303 begin
304 InternalUnPrepare;
305 FParams.Clear;
306 end;
307 FPrepared := Value;
308 end;
309 end;
310
311 procedure TIBQuery.SetParamsFromCursor;
312 var
313 I: Integer;
314 DataSet: TDataSet;
315 Field: TField;
316
317 procedure CheckRequiredParams;
318 var
319 I: Integer;
320 begin
321 for I := 0 to FParams.Count - 1 do
322 with FParams[I] do
323 if not Bound then
324 IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
325 end;
326
327 begin
328 if DataSource <> nil then
329 begin
330 DataSet := DataSource.DataSet;
331 if DataSet <> nil then
332 begin
333 DataSet.FieldDefs.Update;
334 for I := 0 to FParams.Count - 1 do
335 if not FParams[I].Bound then
336 begin
337 Field := DataSet.FindField(FParams[I].Name);
338 if assigned(Field) then
339 begin
340 FParams[I].AssignField(Field);
341 FParams[I].Bound := False;
342 end;
343 end;
344 end
345 else
346 CheckRequiredParams;
347 end
348 else
349 CheckRequiredParams;
350 end;
351
352
353 function TIBQuery.ParamByName(const Value: string): TParam;
354 begin
355 if not Prepared then
356 Prepare;
357 Result := FParams.ParamByName(Value);
358 end;
359
360 procedure TIBQuery.BatchInput(InputObject: TIBBatchInput);
361 begin
362 InternalBatchInput(InputObject);
363 end;
364
365 procedure TIBQuery.BatchOutput(OutputObject: TIBBatchOutput);
366 begin
367 InternalBatchOutput(OutputObject);
368 end;
369
370 procedure TIBQuery.ExecSQL;
371 var
372 DidActivate: Boolean;
373 begin
374 CheckInActive;
375 if SQL.Count <= 0 then
376 IBError(ibxeEmptySQLStatement, [nil]);
377
378 ActivateConnection();
379 DidActivate := ActivateTransaction;
380 try
381 SetPrepared(True);
382 if DataSource <> nil then SetParamsFromCursor;
383 if FParams.Count > 0 then SetParams;
384 InternalExecQuery;
385 finally
386 if DidActivate then
387 DeactivateTransaction;
388 end;
389 end;
390
391 procedure TIBQuery.SetParams;
392
393 var
394 i : integer;
395 Buffer: Pointer;
396 SQLParam: ISQLParam;
397
398 begin
399 for I := 0 to FParams.Count - 1 do
400 begin
401 SQLParam := SQLParams.ByName(Params[i].Name);
402 if Params[i].IsNull then
403 SQLParam.IsNull := True
404 else begin
405 SQLParam.IsNull := False;
406 case Params[i].DataType of
407 ftBytes:
408 begin
409 GetMem(Buffer,Params[i].GetDataSize);
410 try
411 Params[i].GetData(Buffer);
412 SQLParam.AsPointer := Buffer;
413 finally
414 FreeMem(Buffer);
415 end;
416 end;
417 ftString:
418 SQLParam.AsString := Params[i].AsString;
419 ftBoolean:
420 SQLParam.AsBoolean := Params[i].AsBoolean;
421 ftSmallint, ftWord:
422 SQLParam.AsShort := Params[i].AsSmallInt;
423 ftInteger:
424 SQLParam.AsLong := Params[i].AsInteger;
425 ftLargeInt:
426 SQLParam.AsInt64 := Params[i].AsLargeInt;
427 ftFloat:
428 SQLParam.AsDouble := Params[i].AsFloat;
429 ftBCD, ftCurrency:
430 SQLParam.AsCurrency := Params[i].AsCurrency;
431 ftDate:
432 SQLParam.AsDate := Params[i].AsDateTime;
433 ftTime:
434 SQLParam.AsTime := Params[i].AsDateTime;
435 ftDateTime:
436 SQLParam.AsDateTime := Params[i].AsDateTime;
437 ftBlob, ftMemo:
438 SQLParam.AsString := Params[i].AsString;
439 else
440 IBError(ibxeNotSupported, [nil]);
441 end;
442 end;
443 end;
444 end;
445
446 procedure TIBQuery.PrepareSQL;
447 var List: TParams;
448 begin
449 QSelect.GenerateParamNames := GenerateParamNames;
450 InternalPrepare;
451 UpdateSQL;
452 if ParamCheck then
453 begin
454 List := TParams.Create(Self);
455 try
456 FText := List.ParseSQL(SQL.Text, True);
457 List.AssignValues(FParams);
458 FParams.Clear;
459 FParams.Assign(List);
460 finally
461 List.Free;
462 end;
463 end;
464 end;
465
466
467 function TIBQuery.GetRowsAffected: Integer;
468 begin
469 Result := -1;
470 if Prepared then
471 Result := QSelect.RowsAffected
472 end;
473
474
475 procedure TIBQuery.GetDetailLinkFields(MasterFields, DetailFields: TList);
476
477 function AddFieldToList(const FieldName: string; DataSet: TDataSet;
478 List: TList): Boolean;
479 var
480 Field: TField;
481 begin
482 Field := DataSet.FindField(FieldName);
483 if (Field <> nil) then
484 List.Add(Field);
485 Result := Field <> nil;
486 end;
487
488 var
489 i: Integer;
490 begin
491 MasterFields.Clear;
492 DetailFields.Clear;
493 if (DataSource <> nil) and (DataSource.DataSet <> nil) then
494 for i := 0 to Params.Count - 1 do
495 if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
496 AddFieldToList(Params[i].Name, Self, DetailFields);
497 end;
498
499 function TIBQuery.GetStmtHandle: IStatement;
500 begin
501 Result := SelectStmtHandle;
502 end;
503
504 procedure TIBQuery.UpdateSQL;
505 begin
506 if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
507 begin
508 FSQLUpdating := true;
509 try
510 SQL.Text := SelectSQL.Text;
511 finally
512 FSQLUpdating := false
513 end;
514 end;
515 end;
516
517 function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
518 begin
519 Result := False;
520 end;
521
522 procedure TIBQuery.SetFiltered(Value: Boolean);
523 begin
524 if(Filtered <> Value) then
525 begin
526 inherited SetFiltered(value);
527 if Active then
528 begin
529 Close;
530 Open;
531 end;
532 end
533 else
534 inherited SetFiltered(value);
535 end;
536
537 procedure TIBQuery.SQLChanged(Sender: TObject);
538 begin
539 inherited SQLChanged(Sender);
540 UpdateSQL;
541 end;
542
543 procedure TIBQuery.SQLChanging(Sender: TObject);
544 begin
545 inherited SQLChanging(Sender);
546 Prepared := false;
547 end;
548
549 { TIBQuery IProviderSupport }
550 (*
551 function TIBQuery.PSGetParams: TParams;
552 begin
553 Result := Params;
554 end;
555
556 procedure TIBQuery.PSSetParams(AParams: TParams);
557 begin
558 if AParams.Count <> 0 then
559 Params.Assign(AParams);
560 Close;
561 end;
562
563 function TIBQuery.PSGetTableName: string;
564 begin
565 Result := inherited PSGetTableName;
566 end;
567
568 procedure TIBQuery.PSExecute;
569 begin
570 ExecSQL;
571 end;
572
573 procedure TIBQuery.PSSetCommandText(const CommandText: string);
574 begin
575 if CommandText <> '' then
576 SQL.Text := CommandText;
577 end;
578 *)
579 end.
580