ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
Revision: 33
Committed: Sat Jul 18 12:30:52 2015 UTC (8 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 14130 byte(s)
Log Message:
Committing updates for Release R1-3-1

File Contents

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