ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
Revision: 35
Committed: Tue Jan 26 14:38:47 2016 UTC (8 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 14787 byte(s)
Log Message:
Committing updates for Release R1-3-2

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: TISC_STMT_HANDLE;
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: TISC_STMT_HANDLE 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 { TIBQuery }
145
146 constructor TIBQuery.Create(AOwner: TComponent);
147 begin
148 inherited Create(AOwner);
149 FSQL := TStringList.Create;
150 TStringList(SQL).OnChange := QueryChanged;
151 FParams := TParams.Create(Self);
152 ParamCheck := True;
153 FRowsAffected := -1;
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 FRowsAffected := -1;
299 FCheckRowsAffected := True;
300 if Length(Text) > 1 then PrepareSQL
301 else IBError(ibxeEmptySQLStatement, [nil]);
302 end
303 else
304 begin
305 if FCheckRowsAffected then
306 FRowsAffected := RowsAffected;
307 InternalUnPrepare;
308 FParams.Clear;
309 end;
310 FPrepared := Value;
311 end;
312 end;
313
314 procedure TIBQuery.SetParamsFromCursor;
315 var
316 I: Integer;
317 DataSet: TDataSet;
318 Field: TField;
319
320 procedure CheckRequiredParams;
321 var
322 I: Integer;
323 begin
324 for I := 0 to FParams.Count - 1 do
325 with FParams[I] do
326 if not Bound then
327 IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
328 end;
329
330 begin
331 if DataSource <> nil then
332 begin
333 DataSet := DataSource.DataSet;
334 if DataSet <> nil then
335 begin
336 DataSet.FieldDefs.Update;
337 for I := 0 to FParams.Count - 1 do
338 if not FParams[I].Bound then
339 begin
340 Field := DataSet.FindField(FParams[I].Name);
341 if assigned(Field) then
342 begin
343 FParams[I].AssignField(Field);
344 FParams[I].Bound := False;
345 end;
346 end;
347 end
348 else
349 CheckRequiredParams;
350 end
351 else
352 CheckRequiredParams;
353 end;
354
355
356 function TIBQuery.ParamByName(const Value: string): TParam;
357 begin
358 if not Prepared then
359 Prepare;
360 Result := FParams.ParamByName(Value);
361 end;
362
363 procedure TIBQuery.BatchInput(InputObject: TIBBatchInput);
364 begin
365 InternalBatchInput(InputObject);
366 end;
367
368 procedure TIBQuery.BatchOutput(OutputObject: TIBBatchOutput);
369 begin
370 InternalBatchOutput(OutputObject);
371 end;
372
373 procedure TIBQuery.ExecSQL;
374 var
375 DidActivate: Boolean;
376 begin
377 CheckInActive;
378 if SQL.Count <= 0 then
379 begin
380 FCheckRowsAffected := False;
381 IBError(ibxeEmptySQLStatement, [nil]);
382 end;
383 ActivateConnection();
384 DidActivate := ActivateTransaction;
385 try
386 SetPrepared(True);
387 if DataSource <> nil then SetParamsFromCursor;
388 if FParams.Count > 0 then SetParams;
389 InternalExecQuery;
390 finally
391 if DidActivate then
392 DeactivateTransaction;
393 FCheckRowsAffected := True;
394 end;
395 end;
396
397 procedure TIBQuery.SetParams;
398
399 var
400 i : integer;
401 Buffer: Pointer;
402 SQLParam: TIBXSQLVAR;
403
404 begin
405 for I := 0 to FParams.Count - 1 do
406 begin
407 SQLParam := SQLParams.ByName(Params[i].Name);
408 if Params[i].IsNull then
409 SQLParam.IsNull := True
410 else begin
411 SQLParam.IsNull := False;
412 case Params[i].DataType of
413 ftBytes:
414 begin
415 GetMem(Buffer,Params[i].GetDataSize);
416 try
417 Params[i].GetData(Buffer);
418 SQLParam.AsPointer := Buffer;
419 finally
420 FreeMem(Buffer);
421 end;
422 end;
423 ftString:
424 SQLParam.AsString := Params[i].AsString;
425 ftBoolean:
426 SQLParam.AsBoolean := Params[i].AsBoolean;
427 ftSmallint, ftWord:
428 SQLParam.AsShort := Params[i].AsSmallInt;
429 ftInteger:
430 SQLParam.AsLong := Params[i].AsInteger;
431 ftLargeInt:
432 SQLParam.AsInt64 := Params[i].AsLargeInt;
433 ftFloat:
434 SQLParam.AsDouble := Params[i].AsFloat;
435 ftBCD, ftCurrency:
436 SQLParam.AsCurrency := Params[i].AsCurrency;
437 ftDate:
438 SQLParam.AsDate := Params[i].AsDateTime;
439 ftTime:
440 SQLParam.AsTime := Params[i].AsDateTime;
441 ftDateTime:
442 SQLParam.AsDateTime := Params[i].AsDateTime;
443 ftBlob, ftMemo:
444 SQLParam.AsString := Params[i].AsString;
445 else
446 IBError(ibxeNotSupported, [nil]);
447 end;
448 end;
449 end;
450 end;
451
452 procedure TIBQuery.PrepareSQL;
453 var List: TParams;
454 begin
455 QSelect.GenerateParamNames := GenerateParamNames;
456 InternalPrepare;
457 UpdateSQL;
458 if ParamCheck then
459 begin
460 List := TParams.Create(Self);
461 try
462 FText := List.ParseSQL(SQL.Text, True);
463 List.AssignValues(FParams);
464 FParams.Clear;
465 FParams.Assign(List);
466 finally
467 List.Free;
468 end;
469 end;
470 end;
471
472
473 function TIBQuery.GetRowsAffected: Integer;
474 begin
475 Result := -1;
476 if Prepared then
477 Result := QSelect.RowsAffected
478 end;
479
480
481 procedure TIBQuery.GetDetailLinkFields(MasterFields, DetailFields: TList);
482
483 function AddFieldToList(const FieldName: string; DataSet: TDataSet;
484 List: TList): Boolean;
485 var
486 Field: TField;
487 begin
488 Field := DataSet.FindField(FieldName);
489 if (Field <> nil) then
490 List.Add(Field);
491 Result := Field <> nil;
492 end;
493
494 var
495 i: Integer;
496 begin
497 MasterFields.Clear;
498 DetailFields.Clear;
499 if (DataSource <> nil) and (DataSource.DataSet <> nil) then
500 for i := 0 to Params.Count - 1 do
501 if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
502 AddFieldToList(Params[i].Name, Self, DetailFields);
503 end;
504
505 function TIBQuery.GetStmtHandle: TISC_STMT_HANDLE;
506 begin
507 Result := SelectStmtHandle;
508 end;
509
510 procedure TIBQuery.UpdateSQL;
511 begin
512 if not FSQLUpdating and not FInQueryChanged then
513 begin
514 FSQLUpdating := true;
515 try
516 SQL.Text := SelectSQL.Text;
517 finally
518 FSQLUpdating := false
519 end;
520 end;
521 end;
522
523 function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
524 begin
525 Result := False;
526 end;
527
528 procedure TIBQuery.SetFiltered(Value: Boolean);
529 begin
530 if(Filtered <> Value) then
531 begin
532 inherited SetFiltered(value);
533 if Active then
534 begin
535 Close;
536 Open;
537 end;
538 end
539 else
540 inherited SetFiltered(value);
541 end;
542
543 procedure TIBQuery.SQLChanged(Sender: TObject);
544 begin
545 inherited SQLChanged(Sender);
546 UpdateSQL;
547 end;
548
549 procedure TIBQuery.SQLChanging(Sender: TObject);
550 begin
551 inherited SQLChanging(Sender);
552 Prepared := false;
553 end;
554
555 { TIBQuery IProviderSupport }
556 (*
557 function TIBQuery.PSGetParams: TParams;
558 begin
559 Result := Params;
560 end;
561
562 procedure TIBQuery.PSSetParams(AParams: TParams);
563 begin
564 if AParams.Count <> 0 then
565 Params.Assign(AParams);
566 Close;
567 end;
568
569 function TIBQuery.PSGetTableName: string;
570 begin
571 Result := inherited PSGetTableName;
572 end;
573
574 procedure TIBQuery.PSExecute;
575 begin
576 ExecSQL;
577 end;
578
579 procedure TIBQuery.PSSetCommandText(const CommandText: string);
580 begin
581 if CommandText <> '' then
582 SQL.Text := CommandText;
583 end;
584 *)
585 end.
586