ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 14819 byte(s)
Log Message:
Committing updates for Release R2-0-0

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