ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (10 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 14212 byte(s)
Log Message:
Committing updates for Release R1-0-5

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