ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBQuery.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBQuery.pas (file contents):
Revision 31 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines