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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 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;
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 <
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 >

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines