ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
Revision: 19
Committed: Mon Jul 7 13:00:15 2014 UTC (9 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 14078 byte(s)
Log Message:
Committing updates for Release R1-1-0

File Contents

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