ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUpdateSQL.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBUpdateSQL.pas (file contents):
Revision 1 by tony, Mon Jul 31 16:43:00 2000 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 IBUpdateSQL;
35  
36 + {$Mode Delphi}
37 +
38   interface
39  
40 < uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
34 <     IB, IBCustomDataSet, IBQuery;
40 > uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL;
41  
42   type
43   { TIBUpdateSQL }
# Line 39 | Line 45 | type
45    TIBUpdateSQL = class(TIBDataSetUpdateObject)
46    private
47      FDataSet: TIBCustomDataSet;
48 <    FQueries: array[TUpdateKind] of TIBQuery;
48 >    FQueries: array[TUpdateKind] of TIBSQL;
49      FSQLText: array[TUpdateKind] of TStrings;
50 <    function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
50 >    function GetQuery(UpdateKind: TUpdateKind): TIBSQL;
51      function GetSQLIndex(Index: Integer): TStrings;
52      procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
53      procedure SetSQLIndex(Index: Integer; Value: TStrings);
54    protected
55 +    procedure InternalPrepare(UpdateKind: TUpdateKind);
56      function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
57      function GetDataSet: TIBCustomDataSet; override;
58      procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
59      procedure SQLChanged(Sender: TObject);
60 +    procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override;
61 +    procedure ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
62    public
63      constructor Create(AOwner: TComponent); override;
64      destructor Destroy; override;
56    procedure Apply(UpdateKind: TUpdateKind); override;
57    procedure ExecSQL(UpdateKind: TUpdateKind);
58    procedure SetParams(UpdateKind: TUpdateKind);
65      property DataSet;
66 <    property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
66 >    property Query[UpdateKind: TUpdateKind]: TIBSQL read GetQuery;
67      property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
68    published
69      property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
# Line 67 | Line 73 | type
73  
74   implementation
75  
76 + uses Variants;
77 +
78   { TIBUpdateSQL }
79  
80   constructor TIBUpdateSQL.Create(AOwner: TComponent);
# Line 92 | Line 100 | begin
100    inherited Destroy;
101   end;
102  
103 < procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
103 > procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
104   begin
105 +  InternalPrepare(UpdateKind);
106    with Query[UpdateKind] do
107    begin
108 <    Prepare;
109 <    ExecSQL;
110 <    if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
108 >    ExecQuery;
109 > //    if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
110 > // Commented out in release 1.2
111 >    if FieldCount > 0 then  {Has RETURNING Clause}
112 >      UpdateRecordFromQuery(UpdateKind,Current,Buff);
113    end;
114   end;
115  
116 < function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
116 > function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
117   begin
118    if not Assigned(FQueries[UpdateKind]) then
119    begin
120 <    FQueries[UpdateKind] := TIBQuery.Create(Self);
120 >    FQueries[UpdateKind] := TIBSQL.Create(Self);
121      FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
122      if (FDataSet is TIBCustomDataSet) then
123      begin
# Line 147 | Line 158 | begin
158    SetSQL(TUpdateKind(Index), Value);
159   end;
160  
161 + procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
162 + begin
163 +  with Query[UpdateKind] do
164 +  begin
165 +    with Transaction do
166 +      if not InTransaction then StartTransaction;
167 +    if not Prepared then Prepare;
168 +  end;
169 + end;
170 +
171   procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
172   var
173    UpdateKind: TUpdateKind;
# Line 155 | Line 176 | begin
176      if Sender = FSQLText[UpdateKind] then
177      begin
178        if Assigned(FQueries[UpdateKind]) then
158      begin
159        FQueries[UpdateKind].Params.Clear;
179          FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
161      end;
180        Break;
181      end;
182   end;
183  
184 < procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
167 < var
168 <  I: Integer;
169 <  Old: Boolean;
170 <  Param: TParam;
171 <  PName: string;
172 <  Field: TField;
173 <  Value: Variant;
184 > procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
185   begin
186    if not Assigned(FDataSet) then Exit;
187 <  with Query[UpdateKind] do
188 <  begin
189 <    for I := 0 to Params.Count - 1 do
179 <    begin
180 <      Param := Params[I];
181 <      PName := Param.Name;
182 <      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
183 <      if Old then
184 <        System.Delete(PName, 1, 4);
185 <      Field := FDataSet.FindField(PName);
186 <      if not Assigned(Field) then
187 <        Continue;
188 <      if Old then
189 <        Param.AssignFieldValue(Field, Field.OldValue) else
190 <      begin
191 <        Value := Field.NewValue;
192 <        if VarIsEmpty(Value) then
193 <          Value := Field.OldValue;
194 <        Param.AssignFieldValue(Field, Value);
195 <      end;
196 <    end;
197 <  end;
198 < end;
199 <
200 < procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
201 < begin
202 <  SetParams(UpdateKind);
203 <  ExecSQL(UpdateKind);
187 >  InternalPrepare(UpdateKind);
188 >  InternalSetParams(Query[UpdateKind].Params,buff);
189 >  ExecSQL(UpdateKind,buff);
190   end;
191  
192   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines