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