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