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, 9 months ago) by tony
Content type: text/x-pascal
File size: 12986 byte(s)
Log Message:
Committing updates for Release pre-release

File Contents

# Content
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 {$Mode Delphi}
34
35 uses
36 {$IFDEF LINUX }
37 unix,
38 {$ELSE}
39 Windows,
40 {$ENDIF}
41 SysUtils, Graphics, Classes, Controls, Db,
42 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 (* procedure PSExecute; override;
73 function PSGetParams: TParams; override;
74 function PSGetTableName: string; override;
75 procedure PSSetCommandText(const CommandText: string); override;
76 procedure PSSetParams(AParams: TParams); override; *)
77
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 procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
93 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 inherited InitFieldDefs;
153 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 (*
482 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 *)
510 end.
511