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 33 by tony, Sat Jul 18 12:30:52 2015 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      function GetRowsAffected: Integer;
63 <    procedure PrepareSQL(Value: PChar);
63 >    procedure PrepareSQL;
64      procedure QueryChanged(Sender: TObject);
65      procedure ReadParamData(Reader: TReader);
66      procedure SetQuery(Value: TStrings);
# Line 75 | Line 80 | type
80      procedure PSSetCommandText(const CommandText: string); override;
81      procedure PSSetParams(AParams: TParams); override;  *)
82  
83 +    function CreateParser: TSelectSQLParser; override;
84      procedure DefineProperties(Filer: TFiler); override;
85      procedure InitFieldDefs; override;
86      procedure InternalOpen; override;
# Line 99 | Line 105 | type
105      property StatementType;
106      property Text: string read FText;
107      property RowsAffected: Integer read GetRowsAffected;
108 <    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
108 > //   property Params: TParams read FParams write SetParamsList;
109 >    property BaseSQLSelect;
110  
111    published
112      property Active;
113 +    property AutoCommit;
114      property BufferChunks;
115      property CachedUpdates;
116      property DataSource read GetDataSource write SetDataSource;
117 <    property Constraints stored ConstraintsStored;
117 >    property GenerateParamNames;
118 > //   property Constraints stored ConstraintsStored;
119 >    property GeneratorField;
120      property ParamCheck;
121      property SQL: TStrings read FSQL write SetQuery;
122 <    property Params: TParams read FParams write SetParamsList stored False;
122 >    property Params: TParams read FParams write SetParamsList;
123      property UniDirectional default False;
124      property UpdateObject;
125      property Filtered;
126 +    property DataSetCloseAction;
127  
128      property BeforeDatabaseDisconnect;
129      property AfterDatabaseDisconnect;
# Line 121 | Line 132 | type
132      property AfterTransactionEnd;
133      property TransactionFree;
134      property OnFilterRecord;
135 +    property OnValidatePost;
136   end;
137  
138   implementation
# Line 134 | Line 146 | begin
146    TStringList(SQL).OnChange := QueryChanged;
147    FParams := TParams.Create(Self);
148    ParamCheck := True;
137 –  FGenerateParamNames := False;
149    FRowsAffected := -1;
150   end;
151  
# Line 156 | Line 167 | procedure TIBQuery.InternalOpen;
167   begin
168    ActivateConnection();
169    ActivateTransaction;
170 <  QSelect.GenerateParamNames := FGenerateParamNames;
170 >  QSelect.GenerateParamNames := GenerateParamNames;
171    SetPrepared(True);
172    if DataSource <> nil then
173      SetParamsFromCursor;
# Line 209 | Line 220 | begin
220    if not (csReading in ComponentState) then
221    begin
222      Disconnect;
223 +    if HasParser and not FSQLUpdating then
224 +    begin
225 +      FSQLUpdating := true;
226 +      try
227 +        SQL.Text := Parser.SQLText;
228 +      finally
229 +        FSQLUpdating := false
230 +      end;
231 +    end;
232      if ParamCheck or (csDesigning in ComponentState) then
233      begin
234        List := TParams.Create(Self);
# Line 224 | Line 244 | begin
244        FText := SQL.Text;
245      DataEvent(dePropertyChange, 0);
246    end else
247 <    FText := FParams.ParseSQL(SQL.Text, False);
247 >    FText := FParams.ParseSQL(SQL.Text, true);
248    SelectSQL.Assign(SQL);
249   end;
250  
# 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 272 | Line 296 | begin
296      begin
297        FRowsAffected := -1;
298        FCheckRowsAffected := True;
299 <      if Length(Text) > 1 then PrepareSQL(PChar(Text))
299 >      if Length(Text) > 1 then PrepareSQL
300        else IBError(ibxeEmptySQLStatement, [nil]);
301      end
302      else
# Line 289 | Line 313 | procedure TIBQuery.SetParamsFromCursor;
313   var
314    I: Integer;
315    DataSet: TDataSet;
316 +  Field: TField;
317  
318    procedure CheckRequiredParams;
319    var
# Line 297 | Line 322 | var
322      for I := 0 to FParams.Count - 1 do
323      with FParams[I] do
324        if not Bound then
325 <        IBError(ibxeRequiredParamNotSet, [nil]);
325 >        IBError(ibxeRequiredParamNotSet, [FParams[I].Name]);
326    end;
327  
328   begin
# Line 308 | Line 333 | begin
333      begin
334        DataSet.FieldDefs.Update;
335        for I := 0 to FParams.Count - 1 do
336 <        with FParams[I] do
337 <          if not Bound then
338 <          begin
339 <            AssignField(DataSet.FieldByName(Name));
340 <            Bound := False;
341 <          end;
336 >      if not FParams[I].Bound then
337 >      begin
338 >        Field := DataSet.FindField(FParams[I].Name);
339 >        if assigned(Field) then
340 >        begin
341 >            FParams[I].AssignField(Field);
342 >            FParams[I].Bound := False;
343 >        end;
344 >      end;
345      end
346      else
347        CheckRequiredParams;
# Line 367 | Line 395 | procedure TIBQuery.SetParams;
395   var
396   i : integer;
397   Buffer: Pointer;
398 + SQLParam: TIBXSQLVAR;
399  
400   begin
401    for I := 0 to FParams.Count - 1 do
402    begin
403 +    SQLParam :=  SQLParams.ByName(Params[i].Name);
404      if Params[i].IsNull then
405 <      SQLParams[i].IsNull := True
405 >      SQLParam.IsNull := True
406      else begin
407 <      SQLParams[i].IsNull := False;
407 >      SQLParam.IsNull := False;
408        case Params[i].DataType of
409          ftBytes:
410          begin
411            GetMem(Buffer,Params[i].GetDataSize);
412            try
413              Params[i].GetData(Buffer);
414 <            SQLParams[i].AsPointer := Buffer;
414 >            SQLParam.AsPointer := Buffer;
415            finally
416              FreeMem(Buffer);
417            end;
418          end;
419          ftString:
420 <          SQLParams[i].AsString := Params[i].AsString;
421 <        ftBoolean, ftSmallint, ftWord:
422 <          SQLParams[i].AsShort := Params[i].AsSmallInt;
420 >          SQLParam.AsString := Params[i].AsString;
421 >        ftBoolean:
422 >          SQLParam.AsBoolean := Params[i].AsBoolean;
423 >        ftSmallint, ftWord:
424 >          SQLParam.AsShort := Params[i].AsSmallInt;
425          ftInteger:
426 <          SQLParams[i].AsLong := Params[i].AsInteger;
427 < {        ftLargeInt:
428 <          SQLParams[i].AsInt64 := Params[i].AsLargeInt;  }
426 >          SQLParam.AsLong := Params[i].AsInteger;
427 >        ftLargeInt:
428 >          SQLParam.AsInt64 := Params[i].AsLargeInt;
429          ftFloat:
430 <         SQLParams[i].AsDouble := Params[i].AsFloat;
430 >         SQLParam.AsDouble := Params[i].AsFloat;
431          ftBCD, ftCurrency:
432 <          SQLParams[i].AsCurrency := Params[i].AsCurrency;
432 >          SQLParam.AsCurrency := Params[i].AsCurrency;
433          ftDate:
434 <          SQLParams[i].AsDate := Params[i].AsDateTime;
434 >          SQLParam.AsDate := Params[i].AsDateTime;
435          ftTime:
436 <          SQLParams[i].AsTime := Params[i].AsDateTime;
436 >          SQLParam.AsTime := Params[i].AsDateTime;
437          ftDateTime:
438 <          SQLParams[i].AsDateTime := Params[i].AsDateTime;
438 >          SQLParam.AsDateTime := Params[i].AsDateTime;
439          ftBlob, ftMemo:
440 <          SQLParams[i].AsString := Params[i].AsString;
440 >          SQLParam.AsString := Params[i].AsString;
441          else
442            IBError(ibxeNotSupported, [nil]);
443        end;
# Line 413 | Line 445 | begin
445    end;
446   end;
447  
448 < procedure TIBQuery.PrepareSQL(Value: PChar);
448 > procedure TIBQuery.PrepareSQL;
449   begin
450 <  QSelect.GenerateParamNames := FGenerateParamNames;
450 >  QSelect.GenerateParamNames := GenerateParamNames;
451    InternalPrepare;
452   end;
453  
# Line 457 | Line 489 | begin
489    Result := SelectStmtHandle;
490   end;
491  
492 + function TIBQuery.CreateParser: TSelectSQLParser;
493 + begin
494 +  Result := inherited CreateParser;
495 +  Result.OnSQLChanging := QueryChanged;
496 + end;
497 +
498   function TIBQuery.GenerateQueryForLiveUpdate : Boolean;
499   begin
500    Result := False;

Diff Legend

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