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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 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;
35  
36   interface
37  
38 < uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
39 <     IBHeader, IB, IBCustomDataSet, IBSQL;
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(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;
48 <    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 57 | 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 }
77 <    procedure PSExecute; override;
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;
81 >    procedure PSSetParams(AParams: TParams); override;  *)
82  
83      procedure DefineProperties(Filer: TFiler); override;
84      procedure InitFieldDefs; override;
# Line 74 | 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 81 | Line 96 | type
96      procedure BatchInput(InputObject: TIBBatchInput);
97      procedure BatchOutput(OutputObject: TIBBatchOutput);
98      procedure ExecSQL;
99 <    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
99 >    procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
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 113 | Line 134 | type
134      property AfterTransactionEnd;
135      property TransactionFree;
136      property OnFilterRecord;
137 +    property OnValidatePost;
138   end;
139  
140   implementation
141  
142 + uses FBMessages;
143 +
144   { TIBQuery }
145  
146   constructor TIBQuery.Create(AOwner: TComponent);
# Line 126 | Line 150 | begin
150    TStringList(SQL).OnChange := QueryChanged;
151    FParams := TParams.Create(Self);
152    ParamCheck := True;
129 –  FGenerateParamNames := False;
130 –  FRowsAffected := -1;
153   end;
154  
155   destructor TIBQuery.Destroy;
# Line 141 | Line 163 | end;
163  
164   procedure TIBQuery.InitFieldDefs;
165   begin
166 <  inherited;
166 >  inherited InitFieldDefs;
167   end;
168  
169   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 180 | 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 195 | Line 223 | begin
223   end;
224  
225   procedure TIBQuery.QueryChanged(Sender: TObject);
198 – var
199 –  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);
212 <      finally
213 <        List.Free;
214 <      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 234 | 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 244 | 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 262 | Line 294 | begin
294    begin
295      if Value then
296      begin
297 <      FRowsAffected := -1;
266 <      FCheckRowsAffected := True;
267 <      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
272 –      if FCheckRowsAffected then
273 –        FRowsAffected := RowsAffected;
302        InternalUnPrepare;
303 +      FParams.Clear;
304      end;
305      FPrepared := Value;
306    end;
# Line 281 | Line 310 | procedure TIBQuery.SetParamsFromCursor;
310   var
311    I: Integer;
312    DataSet: TDataSet;
313 +  Field: TField;
314  
315    procedure CheckRequiredParams;
316    var
# Line 289 | 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 300 | 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 317 | 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 336 | Line 371 | var
371   begin
372    CheckInActive;
373    if SQL.Count <= 0 then
339 –  begin
340 –    FCheckRowsAffected := False;
374      IBError(ibxeEmptySQLStatement, [nil]);
375 <  end;
375 >
376    ActivateConnection();
377    DidActivate := ActivateTransaction;
378    try
# Line 350 | Line 383 | begin
383    finally
384      if DidActivate then
385        DeactivateTransaction;
353 –    FCheckRowsAffected := True;
386    end;
387   end;
388  
# Line 359 | 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 405 | 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 444 | 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 469 | Line 532 | begin
532      inherited SetFiltered(value);
533   end;
534  
535 < { TIBQuery IProviderSupport }
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;
550   begin
551    Result := Params;
# Line 498 | Line 573 | begin
573    if CommandText <> '' then
574      SQL.Text := CommandText;
575   end;
576 <
576 > *)
577   end.
578  

Diff Legend

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