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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines