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 45 by tony, Tue Dec 6 10:33:46 2016 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                                                 }
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,
47 <     IBHeader, IB, IBCustomDataSet, IBSQL;
46 > SysUtils, Classes,  Db,
47 >     IBHeader, IB, IBCustomDataSet, IBSQL, IBSQLParser;
48  
49   type
50  
51   { TIBQuery }
52  
53 <  TIBQuery = class(TIBCustomDataSet)
53 >  TIBQuery = class(TIBParserDataSet)
54    private
55      FSQL: TStrings;
56      FPrepared: Boolean;
# Line 53 | Line 58 | type
58      FText: string;
59      FRowsAffected: Integer;
60      FCheckRowsAffected: Boolean;
61 <    FGenerateParamNames: Boolean;
61 >    FSQLUpdating: boolean;
62 >    FInQueryChanged: boolean;
63      function GetRowsAffected: Integer;
64 <    procedure PrepareSQL(Value: PChar);
64 >    procedure PrepareSQL;
65      procedure QueryChanged(Sender: TObject);
66      procedure ReadParamData(Reader: TReader);
67      procedure SetQuery(Value: TStrings);
# Line 65 | Line 71 | type
71      procedure SetPrepared(Value: Boolean);
72      procedure SetPrepare(Value: Boolean);
73      procedure WriteParamData(Writer: TWriter);
74 <    function GetStmtHandle: TISC_STMT_HANDLE;
74 >    function GetStmtHandle: IStatement;
75 >    procedure UpdateSQL;
76  
77    protected
78      { IProviderSupport }
# Line 82 | Line 89 | type
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;
# Line 93 | Line 102 | type
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;
108 >    property StmtHandle: IStatement read GetStmtHandle;
109      property StatementType;
110      property Text: string read FText;
111      property RowsAffected: Integer read GetRowsAffected;
112 <    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
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 Constraints stored ConstraintsStored;
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 stored False;
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;
# Line 121 | Line 136 | type
136      property AfterTransactionEnd;
137      property TransactionFree;
138      property OnFilterRecord;
139 +    property OnValidatePost;
140   end;
141  
142   implementation
143  
144 + uses FBMessages;
145 +
146   { TIBQuery }
147  
148   constructor TIBQuery.Create(AOwner: TComponent);
# Line 134 | Line 152 | begin
152    TStringList(SQL).OnChange := QueryChanged;
153    FParams := TParams.Create(Self);
154    ParamCheck := True;
137 –  FGenerateParamNames := False;
155    FRowsAffected := -1;
156   end;
157  
# Line 156 | Line 173 | procedure TIBQuery.InternalOpen;
173   begin
174    ActivateConnection();
175    ActivateTransaction;
176 <  QSelect.GenerateParamNames := FGenerateParamNames;
176 >  QSelect.GenerateParamNames := GenerateParamNames;
177    SetPrepared(True);
178    if DataSource <> nil then
179      SetParamsFromCursor;
# Line 188 | Line 205 | begin
205    SetPrepared(False);
206   end;
207  
208 + procedure TIBQuery.ResetParser;
209 + begin
210 +  inherited ResetParser;
211 +  UpdateSQL;
212 + end;
213 +
214   procedure TIBQuery.SetQuery(Value: TStrings);
215   begin
216    if SQL.Text <> Value.Text then
# Line 203 | Line 226 | begin
226   end;
227  
228   procedure TIBQuery.QueryChanged(Sender: TObject);
206 – var
207 –  List: TParams;
229   begin
230 <  if not (csReading in ComponentState) then
231 <  begin
232 <    Disconnect;
233 <    if ParamCheck or (csDesigning in ComponentState) then
230 >  if FInQueryChanged then Exit;
231 >  FInQueryChanged := true;
232 >  try
233 >    if not (csReading in ComponentState) then
234      begin
235 <      List := TParams.Create(Self);
236 <      try
237 <        FText := List.ParseSQL(SQL.Text, True);
238 <        List.AssignValues(FParams);
239 <        FParams.Clear;
240 <        FParams.Assign(List);
220 <      finally
221 <        List.Free;
222 <      end;
235 >      Disconnect;
236 >      if csDesigning in ComponentState then
237 >        FText := FParams.ParseSQL(SQL.Text, true)
238 >      else
239 >        FText := SQL.Text;
240 >      DataEvent(dePropertyChange, 0);
241      end else
242 <      FText := SQL.Text;
243 <    DataEvent(dePropertyChange, 0);
244 <  end else
245 <    FText := FParams.ParseSQL(SQL.Text, False);
246 <  SelectSQL.Assign(SQL);
242 >      FText := FParams.ParseSQL(SQL.Text, true);
243 >
244 >    if not FSQLUpdating then
245 >    begin
246 >      Prepared := false;
247 >      SelectSQL.Assign(SQL);
248 >    end;
249 >  finally
250 >    FInQueryChanged := false;
251 >  end;
252   end;
253  
254   procedure TIBQuery.SetParamsList(Value: TParams);
# Line 242 | Line 265 | procedure TIBQuery.DefineProperties(File
265  
266    function WriteData: Boolean;
267    begin
268 <    if Filer.Ancestor <> nil then
269 <      Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else
268 >  {The following results in a stream read error with nested frames. Hence commented out until
269 >   someone fixes the LCL }
270 > {    if Filer.Ancestor <> nil then
271 >      Result := not FParams.IsEqual(TIBQuery(Filer.Ancestor).FParams) else}
272        Result := FParams.Count > 0;
273    end;
274  
# Line 252 | Line 277 | begin
277    Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData); {do not localize}
278   end;
279  
280 +
281   procedure TIBQuery.ReadParamData(Reader: TReader);
282   begin
283 +  FParams.Clear;
284    Reader.ReadValue;
285    Reader.ReadCollection(FParams);
286   end;
# Line 272 | Line 299 | begin
299      begin
300        FRowsAffected := -1;
301        FCheckRowsAffected := True;
302 <      if Length(Text) > 1 then PrepareSQL(PChar(Text))
302 >      if Length(Text) > 1 then PrepareSQL
303        else IBError(ibxeEmptySQLStatement, [nil]);
304      end
305      else
# Line 280 | Line 307 | begin
307        if FCheckRowsAffected then
308          FRowsAffected := RowsAffected;
309        InternalUnPrepare;
310 +      FParams.Clear;
311      end;
312      FPrepared := Value;
313    end;
# Line 289 | Line 317 | procedure TIBQuery.SetParamsFromCursor;
317   var
318    I: Integer;
319    DataSet: TDataSet;
320 +  Field: TField;
321  
322    procedure CheckRequiredParams;
323    var
# Line 297 | Line 326 | var
326      for I := 0 to FParams.Count - 1 do
327      with FParams[I] do
328        if not Bound then
329 <        IBError(ibxeRequiredParamNotSet, [nil]);
329 >        IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
330    end;
331  
332   begin
# Line 308 | Line 337 | begin
337      begin
338        DataSet.FieldDefs.Update;
339        for I := 0 to FParams.Count - 1 do
340 <        with FParams[I] do
341 <          if not Bound then
342 <          begin
343 <            AssignField(DataSet.FieldByName(Name));
344 <            Bound := False;
345 <          end;
340 >      if not FParams[I].Bound then
341 >      begin
342 >        Field := DataSet.FindField(FParams[I].Name);
343 >        if assigned(Field) then
344 >        begin
345 >            FParams[I].AssignField(Field);
346 >            FParams[I].Bound := False;
347 >        end;
348 >      end;
349      end
350      else
351        CheckRequiredParams;
# Line 325 | Line 357 | end;
357  
358   function TIBQuery.ParamByName(const Value: string): TParam;
359   begin
360 +  if not Prepared then
361 +    Prepare;
362    Result := FParams.ParamByName(Value);
363   end;
364  
# Line 367 | Line 401 | procedure TIBQuery.SetParams;
401   var
402   i : integer;
403   Buffer: Pointer;
404 + SQLParam: ISQLParam;
405  
406   begin
407    for I := 0 to FParams.Count - 1 do
408    begin
409 +    SQLParam :=  SQLParams.ByName(Params[i].Name);
410      if Params[i].IsNull then
411 <      SQLParams[i].IsNull := True
411 >      SQLParam.IsNull := True
412      else begin
413 <      SQLParams[i].IsNull := False;
413 >      SQLParam.IsNull := False;
414        case Params[i].DataType of
415          ftBytes:
416          begin
417            GetMem(Buffer,Params[i].GetDataSize);
418            try
419              Params[i].GetData(Buffer);
420 <            SQLParams[i].AsPointer := Buffer;
420 >            SQLParam.AsPointer := Buffer;
421            finally
422              FreeMem(Buffer);
423            end;
424          end;
425          ftString:
426 <          SQLParams[i].AsString := Params[i].AsString;
427 <        ftBoolean, ftSmallint, ftWord:
428 <          SQLParams[i].AsShort := Params[i].AsSmallInt;
426 >          SQLParam.AsString := Params[i].AsString;
427 >        ftBoolean:
428 >          SQLParam.AsBoolean := Params[i].AsBoolean;
429 >        ftSmallint, ftWord:
430 >          SQLParam.AsShort := Params[i].AsSmallInt;
431          ftInteger:
432 <          SQLParams[i].AsLong := Params[i].AsInteger;
433 < {        ftLargeInt:
434 <          SQLParams[i].AsInt64 := Params[i].AsLargeInt;  }
432 >          SQLParam.AsLong := Params[i].AsInteger;
433 >        ftLargeInt:
434 >          SQLParam.AsInt64 := Params[i].AsLargeInt;
435          ftFloat:
436 <         SQLParams[i].AsDouble := Params[i].AsFloat;
436 >         SQLParam.AsDouble := Params[i].AsFloat;
437          ftBCD, ftCurrency:
438 <          SQLParams[i].AsCurrency := Params[i].AsCurrency;
438 >          SQLParam.AsCurrency := Params[i].AsCurrency;
439          ftDate:
440 <          SQLParams[i].AsDate := Params[i].AsDateTime;
440 >          SQLParam.AsDate := Params[i].AsDateTime;
441          ftTime:
442 <          SQLParams[i].AsTime := Params[i].AsDateTime;
442 >          SQLParam.AsTime := Params[i].AsDateTime;
443          ftDateTime:
444 <          SQLParams[i].AsDateTime := Params[i].AsDateTime;
444 >          SQLParam.AsDateTime := Params[i].AsDateTime;
445          ftBlob, ftMemo:
446 <          SQLParams[i].AsString := Params[i].AsString;
446 >          SQLParam.AsString := Params[i].AsString;
447          else
448            IBError(ibxeNotSupported, [nil]);
449        end;
# Line 413 | Line 451 | begin
451    end;
452   end;
453  
454 < procedure TIBQuery.PrepareSQL(Value: PChar);
454 > procedure TIBQuery.PrepareSQL;
455 > var List: TParams;
456   begin
457 <  QSelect.GenerateParamNames := FGenerateParamNames;
457 >  QSelect.GenerateParamNames := GenerateParamNames;
458    InternalPrepare;
459 +  UpdateSQL;
460 +  if ParamCheck  then
461 +  begin
462 +    List := TParams.Create(Self);
463 +    try
464 +      FText := List.ParseSQL(SQL.Text, True);
465 +      List.AssignValues(FParams);
466 +      FParams.Clear;
467 +      FParams.Assign(List);
468 +    finally
469 +      List.Free;
470 +    end;
471 +  end;
472   end;
473  
474  
# Line 452 | Line 504 | begin
504          AddFieldToList(Params[i].Name, Self, DetailFields);
505   end;
506  
507 < function TIBQuery.GetStmtHandle: TISC_STMT_HANDLE;
507 > function TIBQuery.GetStmtHandle: IStatement;
508   begin
509    Result := SelectStmtHandle;
510   end;
511  
512 + procedure TIBQuery.UpdateSQL;
513 + begin
514 +  if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
515 +  begin
516 +    FSQLUpdating := true;
517 +    try
518 +      SQL.Text := SelectSQL.Text;
519 +    finally
520 +      FSQLUpdating := false
521 +    end;
522 +  end;
523 + end;
524 +
525   function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
526   begin
527    Result := False;
# Line 477 | Line 542 | begin
542      inherited SetFiltered(value);
543   end;
544  
545 + procedure TIBQuery.SQLChanged(Sender: TObject);
546 + begin
547 +  inherited SQLChanged(Sender);
548 +  UpdateSQL;
549 + end;
550 +
551 + procedure TIBQuery.SQLChanging(Sender: TObject);
552 + begin
553 +  inherited SQLChanging(Sender);
554 +  Prepared := false;
555 + end;
556 +
557   { TIBQuery IProviderSupport }
558   (*
559   function TIBQuery.PSGetParams: TParams;

Diff Legend

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