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

Diff Legend

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