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 39 by tony, Tue May 17 08:14:52 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;
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;
# Line 45 | 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 58 | Line 72 | type
72      procedure SetPrepare(Value: Boolean);
73      procedure WriteParamData(Writer: TWriter);
74      function GetStmtHandle: TISC_STMT_HANDLE;
75 +    procedure UpdateSQL;
76  
77    protected
78      { IProviderSupport }
79 <    procedure PSExecute; override;
79 > (*    procedure PSExecute; override;
80      function PSGetParams: TParams; override;
81      function PSGetTableName: string; override;
82      procedure PSSetCommandText(const CommandText: string); override;
83 <    procedure PSSetParams(AParams: TParams); override;
83 >    procedure PSSetParams(AParams: TParams); override;  *)
84  
85      procedure DefineProperties(Filer: TFiler); override;
86      procedure InitFieldDefs; override;
# Line 74 | 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 81 | Line 98 | type
98      procedure BatchInput(InputObject: TIBBatchInput);
99      procedure BatchOutput(OutputObject: TIBBatchOutput);
100      procedure ExecSQL;
101 <    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
101 >    procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
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;
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 113 | Line 136 | type
136      property AfterTransactionEnd;
137      property TransactionFree;
138      property OnFilterRecord;
139 +    property OnValidatePost;
140   end;
141  
142   implementation
# Line 126 | Line 150 | begin
150    TStringList(SQL).OnChange := QueryChanged;
151    FParams := TParams.Create(Self);
152    ParamCheck := True;
129 –  FGenerateParamNames := False;
153    FRowsAffected := -1;
154   end;
155  
# Line 141 | Line 164 | end;
164  
165   procedure TIBQuery.InitFieldDefs;
166   begin
167 <  inherited;
167 >  inherited InitFieldDefs;
168   end;
169  
170   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 180 | 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 195 | Line 224 | begin
224   end;
225  
226   procedure TIBQuery.QueryChanged(Sender: TObject);
198 – var
199 –  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);
212 <      finally
213 <        List.Free;
214 <      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 234 | 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 244 | 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 264 | Line 297 | begin
297      begin
298        FRowsAffected := -1;
299        FCheckRowsAffected := True;
300 <      if Length(Text) > 1 then PrepareSQL(PChar(Text))
300 >      if Length(Text) > 1 then PrepareSQL
301        else IBError(ibxeEmptySQLStatement, [nil]);
302      end
303      else
# Line 272 | Line 305 | begin
305        if FCheckRowsAffected then
306          FRowsAffected := RowsAffected;
307        InternalUnPrepare;
308 +      FParams.Clear;
309      end;
310      FPrepared := Value;
311    end;
# Line 281 | Line 315 | procedure TIBQuery.SetParamsFromCursor;
315   var
316    I: Integer;
317    DataSet: TDataSet;
318 +  Field: TField;
319  
320    procedure CheckRequiredParams;
321    var
# Line 289 | Line 324 | var
324      for I := 0 to FParams.Count - 1 do
325      with FParams[I] do
326        if not Bound then
327 <        IBError(ibxeRequiredParamNotSet, [nil]);
327 >        IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
328    end;
329  
330   begin
# Line 300 | Line 335 | begin
335      begin
336        DataSet.FieldDefs.Update;
337        for I := 0 to FParams.Count - 1 do
338 <        with FParams[I] do
339 <          if not Bound then
340 <          begin
341 <            AssignField(DataSet.FieldByName(Name));
342 <            Bound := False;
343 <          end;
338 >      if not FParams[I].Bound then
339 >      begin
340 >        Field := DataSet.FindField(FParams[I].Name);
341 >        if assigned(Field) then
342 >        begin
343 >            FParams[I].AssignField(Field);
344 >            FParams[I].Bound := False;
345 >        end;
346 >      end;
347      end
348      else
349        CheckRequiredParams;
# Line 317 | Line 355 | end;
355  
356   function TIBQuery.ParamByName(const Value: string): TParam;
357   begin
358 +  if not Prepared then
359 +    Prepare;
360    Result := FParams.ParamByName(Value);
361   end;
362  
# Line 359 | Line 399 | procedure TIBQuery.SetParams;
399   var
400   i : integer;
401   Buffer: Pointer;
402 + SQLParam: TIBXSQLVAR;
403  
404   begin
405    for I := 0 to FParams.Count - 1 do
406    begin
407 +    SQLParam :=  SQLParams.ByName(Params[i].Name);
408      if Params[i].IsNull then
409 <      SQLParams[i].IsNull := True
409 >      SQLParam.IsNull := True
410      else begin
411 <      SQLParams[i].IsNull := False;
411 >      SQLParam.IsNull := False;
412        case Params[i].DataType of
413          ftBytes:
414          begin
415            GetMem(Buffer,Params[i].GetDataSize);
416            try
417              Params[i].GetData(Buffer);
418 <            SQLParams[i].AsPointer := Buffer;
418 >            SQLParam.AsPointer := Buffer;
419            finally
420              FreeMem(Buffer);
421            end;
422          end;
423          ftString:
424 <          SQLParams[i].AsString := Params[i].AsString;
425 <        ftBoolean, ftSmallint, ftWord:
426 <          SQLParams[i].AsShort := Params[i].AsSmallInt;
424 >          SQLParam.AsString := Params[i].AsString;
425 >        ftBoolean:
426 >          SQLParam.AsBoolean := Params[i].AsBoolean;
427 >        ftSmallint, ftWord:
428 >          SQLParam.AsShort := Params[i].AsSmallInt;
429          ftInteger:
430 <          SQLParams[i].AsLong := Params[i].AsInteger;
431 < {        ftLargeInt:
432 <          SQLParams[i].AsInt64 := Params[i].AsLargeInt;  }
430 >          SQLParam.AsLong := Params[i].AsInteger;
431 >        ftLargeInt:
432 >          SQLParam.AsInt64 := Params[i].AsLargeInt;
433          ftFloat:
434 <         SQLParams[i].AsDouble := Params[i].AsFloat;
434 >         SQLParam.AsDouble := Params[i].AsFloat;
435          ftBCD, ftCurrency:
436 <          SQLParams[i].AsCurrency := Params[i].AsCurrency;
436 >          SQLParam.AsCurrency := Params[i].AsCurrency;
437          ftDate:
438 <          SQLParams[i].AsDate := Params[i].AsDateTime;
438 >          SQLParam.AsDate := Params[i].AsDateTime;
439          ftTime:
440 <          SQLParams[i].AsTime := Params[i].AsDateTime;
440 >          SQLParam.AsTime := Params[i].AsDateTime;
441          ftDateTime:
442 <          SQLParams[i].AsDateTime := Params[i].AsDateTime;
442 >          SQLParam.AsDateTime := Params[i].AsDateTime;
443          ftBlob, ftMemo:
444 <          SQLParams[i].AsString := Params[i].AsString;
444 >          SQLParam.AsString := Params[i].AsString;
445          else
446            IBError(ibxeNotSupported, [nil]);
447        end;
# Line 405 | Line 449 | begin
449    end;
450   end;
451  
452 < procedure TIBQuery.PrepareSQL(Value: PChar);
452 > procedure TIBQuery.PrepareSQL;
453 > var List: TParams;
454   begin
455 <  QSelect.GenerateParamNames := FGenerateParamNames;
455 >  QSelect.GenerateParamNames := GenerateParamNames;
456    InternalPrepare;
457 +  UpdateSQL;
458 +  if ParamCheck  then
459 +  begin
460 +    List := TParams.Create(Self);
461 +    try
462 +      FText := List.ParseSQL(SQL.Text, True);
463 +      List.AssignValues(FParams);
464 +      FParams.Clear;
465 +      FParams.Assign(List);
466 +    finally
467 +      List.Free;
468 +    end;
469 +  end;
470   end;
471  
472  
# Line 449 | Line 507 | begin
507    Result := SelectStmtHandle;
508   end;
509  
510 + procedure TIBQuery.UpdateSQL;
511 + begin
512 +  if not FSQLUpdating and not FInQueryChanged and (SQL.Text <> SelectSQL.Text) then
513 +  begin
514 +    FSQLUpdating := true;
515 +    try
516 +      SQL.Text := SelectSQL.Text;
517 +    finally
518 +      FSQLUpdating := false
519 +    end;
520 +  end;
521 + end;
522 +
523   function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
524   begin
525    Result := False;
# Line 469 | Line 540 | begin
540      inherited SetFiltered(value);
541   end;
542  
543 < { TIBQuery IProviderSupport }
543 > procedure TIBQuery.SQLChanged(Sender: TObject);
544 > begin
545 >  inherited SQLChanged(Sender);
546 >  UpdateSQL;
547 > end;
548  
549 + procedure TIBQuery.SQLChanging(Sender: TObject);
550 + begin
551 +  inherited SQLChanging(Sender);
552 +  Prepared := false;
553 + end;
554 +
555 + { TIBQuery IProviderSupport }
556 + (*
557   function TIBQuery.PSGetParams: TParams;
558   begin
559    Result := Params;
# Line 498 | Line 581 | begin
581    if CommandText <> '' then
582      SQL.Text := CommandText;
583   end;
584 <
584 > *)
585   end.
586  

Diff Legend

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