ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
Revision: 5
Committed: Fri Feb 18 16:26:16 2011 UTC (13 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 12986 byte(s)
Log Message:
Committing updates for Release pre-release

File Contents

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