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 (6 years, 6 months ago) by tony
File size: 14212 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line File contents
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 { 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