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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 24 | Line 24
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 - 2018                                               }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBQuery;
# Line 33 | Line 38 | interface
38   {$Mode Delphi}
39  
40   uses
41 < {$IFDEF LINUX }
37 <  unix,
38 < {$ELSE}
41 > {$IFDEF WINDOWS }
42    Windows,
43 + {$ELSE}
44 +  unix,
45   {$ENDIF}
46 < SysUtils, Graphics, Classes, Controls, Db,
42 <     IBHeader, IB, IBCustomDataSet, IBSQL;
46 > SysUtils, Classes,  Db, IB, IBCustomDataSet, IBSQL;
47  
48   type
49  
50   { TIBQuery }
51  
52 <  TIBQuery = class(TIBCustomDataSet)
52 >  TIBQuery = class(TIBParserDataSet)
53    private
54      FSQL: TStrings;
55      FPrepared: Boolean;
56      FParams: TParams;
57      FText: string;
58 <    FRowsAffected: Integer;
59 <    FCheckRowsAffected: Boolean;
56 <    FGenerateParamNames: Boolean;
58 >    FSQLUpdating: boolean;
59 >    FInQueryChanged: boolean;
60      function GetRowsAffected: Integer;
61 <    procedure PrepareSQL(Value: PChar);
61 >    procedure PrepareSQL;
62      procedure QueryChanged(Sender: TObject);
63      procedure ReadParamData(Reader: TReader);
64      procedure SetQuery(Value: TStrings);
# Line 65 | Line 68 | type
68      procedure SetPrepared(Value: Boolean);
69      procedure SetPrepare(Value: Boolean);
70      procedure WriteParamData(Writer: TWriter);
71 <    function GetStmtHandle: TISC_STMT_HANDLE;
71 >    function GetStmtHandle: IStatement;
72 >    procedure UpdateSQL;
73  
74    protected
75      { IProviderSupport }
# Line 82 | Line 86 | type
86      function GetParamsCount: Word;
87      function GenerateQueryForLiveUpdate : Boolean;
88      procedure SetFiltered(Value: Boolean); override;
89 +    procedure SQLChanged(Sender: TObject); override;
90 +    procedure SQLChanging(Sender: TObject); override;
91  
92    public
93      constructor Create(AOwner: TComponent); override;
# Line 93 | Line 99 | type
99      function ParamByName(const Value: string): TParam;
100      procedure Prepare;
101      procedure UnPrepare;
102 +    procedure ResetParser; override;
103      property Prepared: Boolean read FPrepared write SetPrepare;
104      property ParamCount: Word read GetParamsCount;
105 <    property StmtHandle: TISC_STMT_HANDLE read GetStmtHandle;
105 >    property StmtHandle: IStatement read GetStmtHandle;
106      property StatementType;
107      property Text: string read FText;
108      property RowsAffected: Integer read GetRowsAffected;
109 <    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
109 > //   property Params: TParams read FParams write SetParamsList;
110 >    property BaseSQLSelect;
111  
112    published
113      property Active;
114 +    property AutoCommit;
115      property BufferChunks;
116      property CachedUpdates;
117      property DataSource read GetDataSource write SetDataSource;
118 <    property Constraints stored ConstraintsStored;
118 >    property GenerateParamNames;
119 > //   property Constraints stored ConstraintsStored;
120 >    property GeneratorField;
121      property ParamCheck;
122      property SQL: TStrings read FSQL write SetQuery;
123 <    property Params: TParams read FParams write SetParamsList stored False;
123 >    property Params: TParams read FParams write SetParamsList;
124      property UniDirectional default False;
125      property UpdateObject;
126      property Filtered;
127 +    property DataSetCloseAction;
128  
129      property BeforeDatabaseDisconnect;
130      property AfterDatabaseDisconnect;
# Line 121 | Line 133 | type
133      property AfterTransactionEnd;
134      property TransactionFree;
135      property OnFilterRecord;
136 +    property OnValidatePost;
137 +    property OnDeleteReturning;
138   end;
139  
140   implementation
141  
142 + uses FBMessages;
143 +
144   { TIBQuery }
145  
146   constructor TIBQuery.Create(AOwner: TComponent);
# Line 134 | Line 150 | begin
150    TStringList(SQL).OnChange := QueryChanged;
151    FParams := TParams.Create(Self);
152    ParamCheck := True;
137 –  FGenerateParamNames := False;
138 –  FRowsAffected := -1;
153   end;
154  
155   destructor TIBQuery.Destroy;
# Line 156 | Line 170 | procedure TIBQuery.InternalOpen;
170   begin
171    ActivateConnection();
172    ActivateTransaction;
173 <  QSelect.GenerateParamNames := FGenerateParamNames;
173 >  QSelect.GenerateParamNames := GenerateParamNames;
174    SetPrepared(True);
175    if DataSource <> nil then
176      SetParamsFromCursor;
# Line 188 | Line 202 | begin
202    SetPrepared(False);
203   end;
204  
205 + procedure TIBQuery.ResetParser;
206 + begin
207 +  inherited ResetParser;
208 +  UpdateSQL;
209 + end;
210 +
211   procedure TIBQuery.SetQuery(Value: TStrings);
212   begin
213    if SQL.Text <> Value.Text then
# Line 203 | Line 223 | begin
223   end;
224  
225   procedure TIBQuery.QueryChanged(Sender: TObject);
206 – var
207 –  List: TParams;
226   begin
227 <  if not (csReading in ComponentState) then
228 <  begin
229 <    Disconnect;
230 <    if ParamCheck or (csDesigning in ComponentState) then
227 >  if FInQueryChanged then Exit;
228 >  FInQueryChanged := true;
229 >  try
230 >    if not (csReading 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);
220 <      finally
221 <        List.Free;
222 <      end;
232 >      Disconnect;
233 >      if csDesigning in ComponentState then
234 >        FText := FParams.ParseSQL(SQL.Text, true)
235 >      else
236 >        FText := SQL.Text;
237 >      DataEvent(dePropertyChange, 0);
238      end else
239 <      FText := SQL.Text;
240 <    DataEvent(dePropertyChange, 0);
241 <  end else
242 <    FText := FParams.ParseSQL(SQL.Text, False);
243 <  SelectSQL.Assign(SQL);
239 >      FText := FParams.ParseSQL(SQL.Text, true);
240 >
241 >    if not FSQLUpdating then
242 >    begin
243 >      Prepared := false;
244 >      SelectSQL.Assign(SQL);
245 >    end;
246 >  finally
247 >    FInQueryChanged := false;
248 >  end;
249   end;
250  
251   procedure TIBQuery.SetParamsList(Value: TParams);
# Line 242 | Line 262 | procedure TIBQuery.DefineProperties(File
262  
263    function WriteData: Boolean;
264    begin
265 <    if Filer.Ancestor <> nil then
266 <      Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else
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  
# Line 252 | Line 274 | begin
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;
# Line 270 | Line 294 | begin
294    begin
295      if Value then
296      begin
297 <      FRowsAffected := -1;
274 <      FCheckRowsAffected := True;
275 <      if Length(Text) > 1 then PrepareSQL(PChar(Text))
297 >      if Length(Text) > 1 then PrepareSQL
298        else IBError(ibxeEmptySQLStatement, [nil]);
299      end
300      else
301      begin
280 –      if FCheckRowsAffected then
281 –        FRowsAffected := RowsAffected;
302        InternalUnPrepare;
303 +      FParams.Clear;
304      end;
305      FPrepared := Value;
306    end;
# Line 289 | Line 310 | procedure TIBQuery.SetParamsFromCursor;
310   var
311    I: Integer;
312    DataSet: TDataSet;
313 +  Field: TField;
314  
315    procedure CheckRequiredParams;
316    var
# Line 297 | Line 319 | var
319      for I := 0 to FParams.Count - 1 do
320      with FParams[I] do
321        if not Bound then
322 <        IBError(ibxeRequiredParamNotSet, [nil]);
322 >        IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
323    end;
324  
325   begin
# Line 308 | Line 330 | begin
330      begin
331        DataSet.FieldDefs.Update;
332        for I := 0 to FParams.Count - 1 do
333 <        with FParams[I] do
334 <          if not Bound then
335 <          begin
336 <            AssignField(DataSet.FieldByName(Name));
337 <            Bound := False;
338 <          end;
333 >      if not FParams[I].Bound then
334 >      begin
335 >        Field := DataSet.FindField(FParams[I].Name);
336 >        if assigned(Field) then
337 >        begin
338 >            FParams[I].AssignField(Field);
339 >            FParams[I].Bound := False;
340 >        end;
341 >      end;
342      end
343      else
344        CheckRequiredParams;
# Line 325 | Line 350 | end;
350  
351   function TIBQuery.ParamByName(const Value: string): TParam;
352   begin
353 +  if not Prepared then
354 +    Prepare;
355    Result := FParams.ParamByName(Value);
356   end;
357  
# Line 344 | Line 371 | var
371   begin
372    CheckInActive;
373    if SQL.Count <= 0 then
347 –  begin
348 –    FCheckRowsAffected := False;
374      IBError(ibxeEmptySQLStatement, [nil]);
375 <  end;
375 >
376    ActivateConnection();
377    DidActivate := ActivateTransaction;
378    try
# Line 358 | Line 383 | begin
383    finally
384      if DidActivate then
385        DeactivateTransaction;
361 –    FCheckRowsAffected := True;
386    end;
387   end;
388  
# Line 367 | Line 391 | procedure TIBQuery.SetParams;
391   var
392   i : integer;
393   Buffer: Pointer;
394 + SQLParam: ISQLParam;
395  
396   begin
397    for I := 0 to FParams.Count - 1 do
398    begin
399 +    SQLParam :=  SQLParams.ByName(Params[i].Name);
400      if Params[i].IsNull then
401 <      SQLParams[i].IsNull := True
401 >      SQLParam.IsNull := True
402      else begin
403 <      SQLParams[i].IsNull := False;
403 >      SQLParam.IsNull := False;
404        case Params[i].DataType of
405          ftBytes:
406          begin
407            GetMem(Buffer,Params[i].GetDataSize);
408            try
409              Params[i].GetData(Buffer);
410 <            SQLParams[i].AsPointer := Buffer;
410 >            SQLParam.AsPointer := Buffer;
411            finally
412              FreeMem(Buffer);
413            end;
414          end;
415          ftString:
416 <          SQLParams[i].AsString := Params[i].AsString;
417 <        ftBoolean, ftSmallint, ftWord:
418 <          SQLParams[i].AsShort := Params[i].AsSmallInt;
416 >          SQLParam.AsString := Params[i].AsString;
417 >        ftBoolean:
418 >          SQLParam.AsBoolean := Params[i].AsBoolean;
419 >        ftSmallint, ftWord:
420 >          SQLParam.AsShort := Params[i].AsSmallInt;
421          ftInteger:
422 <          SQLParams[i].AsLong := Params[i].AsInteger;
423 < {        ftLargeInt:
424 <          SQLParams[i].AsInt64 := Params[i].AsLargeInt;  }
422 >          SQLParam.AsLong := Params[i].AsInteger;
423 >        ftLargeInt:
424 >          SQLParam.AsInt64 := Params[i].AsLargeInt;
425          ftFloat:
426 <         SQLParams[i].AsDouble := Params[i].AsFloat;
426 >         SQLParam.AsDouble := Params[i].AsFloat;
427          ftBCD, ftCurrency:
428 <          SQLParams[i].AsCurrency := Params[i].AsCurrency;
428 >          SQLParam.AsCurrency := Params[i].AsCurrency;
429          ftDate:
430 <          SQLParams[i].AsDate := Params[i].AsDateTime;
430 >          SQLParam.AsDate := Params[i].AsDateTime;
431          ftTime:
432 <          SQLParams[i].AsTime := Params[i].AsDateTime;
432 >          SQLParam.AsTime := Params[i].AsDateTime;
433          ftDateTime:
434 <          SQLParams[i].AsDateTime := Params[i].AsDateTime;
434 >          SQLParam.AsDateTime := Params[i].AsDateTime;
435          ftBlob, ftMemo:
436 <          SQLParams[i].AsString := Params[i].AsString;
436 >          SQLParam.AsString := Params[i].AsString;
437          else
438            IBError(ibxeNotSupported, [nil]);
439        end;
# Line 413 | Line 441 | begin
441    end;
442   end;
443  
444 < procedure TIBQuery.PrepareSQL(Value: PChar);
444 > procedure TIBQuery.PrepareSQL;
445 > var List: TParams;
446   begin
447 <  QSelect.GenerateParamNames := FGenerateParamNames;
447 >  QSelect.GenerateParamNames := GenerateParamNames;
448    InternalPrepare;
449 +  UpdateSQL;
450 +  if ParamCheck  then
451 +  begin
452 +    List := TParams.Create(Self);
453 +    try
454 +      FText := List.ParseSQL(SQL.Text, True);
455 +      List.AssignValues(FParams);
456 +      FParams.Clear;
457 +      FParams.Assign(List);
458 +    finally
459 +      List.Free;
460 +    end;
461 +  end;
462   end;
463  
464  
# Line 452 | Line 494 | begin
494          AddFieldToList(Params[i].Name, Self, DetailFields);
495   end;
496  
497 < function TIBQuery.GetStmtHandle: TISC_STMT_HANDLE;
497 > function TIBQuery.GetStmtHandle: IStatement;
498   begin
499    Result := SelectStmtHandle;
500   end;
501  
502 + procedure TIBQuery.UpdateSQL;
503 + begin
504 +  if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
505 +  begin
506 +    FSQLUpdating := true;
507 +    try
508 +      SQL.Text := SelectSQL.Text;
509 +    finally
510 +      FSQLUpdating := false
511 +    end;
512 +  end;
513 + end;
514 +
515   function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
516   begin
517    Result := False;
# Line 477 | Line 532 | begin
532      inherited SetFiltered(value);
533   end;
534  
535 + procedure TIBQuery.SQLChanged(Sender: TObject);
536 + begin
537 +  inherited SQLChanged(Sender);
538 +  UpdateSQL;
539 + end;
540 +
541 + procedure TIBQuery.SQLChanging(Sender: TObject);
542 + begin
543 +  inherited SQLChanging(Sender);
544 +  Prepared := false;
545 + end;
546 +
547   { TIBQuery IProviderSupport }
548   (*
549   function TIBQuery.PSGetParams: TParams;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines