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 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;
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      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 61 | Line 74 | type
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 +    function CreateParser: TSelectSQLParser; override;
84      procedure DefineProperties(Filer: TFiler); override;
85      procedure InitFieldDefs; override;
86      procedure InternalOpen; override;
# Line 81 | Line 95 | type
95      procedure BatchInput(InputObject: TIBBatchInput);
96      procedure BatchOutput(OutputObject: TIBBatchOutput);
97      procedure ExecSQL;
98 <    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
98 >    procedure GetDetailLinkFields(MasterFields, DetailFields: TList);(* override;*)
99      function ParamByName(const Value: string): TParam;
100      procedure Prepare;
101      procedure UnPrepare;
# Line 91 | 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 113 | Line 132 | type
132      property AfterTransactionEnd;
133      property TransactionFree;
134      property OnFilterRecord;
135 +    property OnValidatePost;
136   end;
137  
138   implementation
# Line 126 | Line 146 | begin
146    TStringList(SQL).OnChange := QueryChanged;
147    FParams := TParams.Create(Self);
148    ParamCheck := True;
129 –  FGenerateParamNames := False;
149    FRowsAffected := -1;
150   end;
151  
# Line 141 | Line 160 | end;
160  
161   procedure TIBQuery.InitFieldDefs;
162   begin
163 <  inherited;
163 >  inherited InitFieldDefs;
164   end;
165  
166   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 201 | 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 216 | 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 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 264 | 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 281 | Line 313 | procedure TIBQuery.SetParamsFromCursor;
313   var
314    I: Integer;
315    DataSet: TDataSet;
316 +  Field: TField;
317  
318    procedure CheckRequiredParams;
319    var
# Line 289 | 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 300 | 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 359 | 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 405 | 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 449 | 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;
# Line 470 | Line 516 | begin
516   end;
517  
518   { TIBQuery IProviderSupport }
519 <
519 > (*
520   function TIBQuery.PSGetParams: TParams;
521   begin
522    Result := Params;
# Line 498 | Line 544 | begin
544    if CommandText <> '' then
545      SQL.Text := CommandText;
546   end;
547 <
547 > *)
548   end.
549  

Diff Legend

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