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 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC

# Line 1 | Line 1
1 < {************************************************************************}
2 < {                                                                        }
3 < {       Borland Delphi Visual Component Library                          }
4 < {       InterBase Express core components                                }
5 < {                                                                        }
6 < {       Copyright (c) 1998-2000 Inprise Corporation                      }
7 < {                                                                        }
8 < {    InterBase Express is based in part on the product                   }
9 < {    Free IB Components, written by Gregory H. Deatz for                 }
10 < {    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
11 < {    Free IB Components is used under license.                           }
12 < {                                                                        }
13 < {    The contents of this file are subject to the InterBase              }
14 < {    Public License Version 1.0 (the "License"); you may not             }
15 < {    use this file except in compliance with the License. You            }
16 < {    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 < {    Software distributed under the License is distributed on            }
18 < {    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19 < {    express or implied. See the License for the specific language       }
20 < {    governing rights and limitations under the License.                 }
21 < {    The Original Code was created by InterBase Software Corporation     }
22 < {       and its successors.                                              }
23 < {    Portions created by Inprise Corporation are Copyright (C) Inprise   }
24 < {       Corporation. All Rights Reserved.                                }
25 < {    Contributor(s): Jeff Overcash                                       }
26 < {                                                                        }
27 < {************************************************************************}
28 <
29 < unit IBUpdateSQL;
30 <
31 < {$Mode Delphi}
32 <
33 < interface
34 <
35 < uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBQuery;
36 <
37 < type
38 < { TIBUpdateSQL }
39 <
40 <  TIBUpdateSQL = class(TIBDataSetUpdateObject)
41 <  private
42 <    FDataSet: TIBCustomDataSet;
43 <    FQueries: array[TUpdateKind] of TIBQuery;
44 <    FSQLText: array[TUpdateKind] of TStrings;
45 <    function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
46 <    function GetSQLIndex(Index: Integer): TStrings;
47 <    procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
48 <    procedure SetSQLIndex(Index: Integer; Value: TStrings);
49 <  protected
50 <    function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
51 <    function GetDataSet: TIBCustomDataSet; override;
52 <    procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
53 <    procedure SQLChanged(Sender: TObject);
54 <  public
55 <    constructor Create(AOwner: TComponent); override;
56 <    destructor Destroy; override;
57 <    procedure Apply(UpdateKind: TUpdateKind); override;
58 <    procedure ExecSQL(UpdateKind: TUpdateKind);
59 <    procedure SetParams(UpdateKind: TUpdateKind);
60 <    property DataSet;
61 <    property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
62 <    property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
63 <  published
64 <    property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
65 <    property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
66 <    property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
67 <  end;
68 <
69 < implementation
70 <
71 < uses Variants;
72 <
73 < { TIBUpdateSQL }
74 <
75 < constructor TIBUpdateSQL.Create(AOwner: TComponent);
76 < var
77 <  UpdateKind: TUpdateKind;
78 < begin
79 <  inherited Create(AOwner);
80 <  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
81 <  begin
82 <    FSQLText[UpdateKind] := TStringList.Create;
83 <    TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
84 <  end;
85 < end;
86 <
87 < destructor TIBUpdateSQL.Destroy;
88 < var
89 <  UpdateKind: TUpdateKind;
90 < begin
91 <  if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
92 <    FDataSet.UpdateObject := nil;
93 <  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
94 <    FSQLText[UpdateKind].Free;
95 <  inherited Destroy;
96 < end;
97 <
98 < procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
99 < begin
100 <  with Query[UpdateKind] do
101 <  begin
102 <    Prepare;
103 <    ExecSQL;
104 <    if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
105 <  end;
106 < end;
107 <
108 < function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
109 < begin
110 <  if not Assigned(FQueries[UpdateKind]) then
111 <  begin
112 <    FQueries[UpdateKind] := TIBQuery.Create(Self);
113 <    FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
114 <    if (FDataSet is TIBCustomDataSet) then
115 <    begin
116 <      FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
117 <      FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
118 <    end;
119 <  end;
120 <  Result := FQueries[UpdateKind];
121 < end;
122 <
123 < function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
124 < begin
125 <  Result := FSQLText[UpdateKind];
126 < end;
127 <
128 < function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
129 < begin
130 <  Result := FSQLText[TUpdateKind(Index)];
131 < end;
132 <
133 < function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
134 < begin
135 <  Result := FDataSet;
136 < end;
137 <
138 < procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
139 < begin
140 <  FDataSet := ADataSet;
141 < end;
142 <
143 < procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
144 < begin
145 <  FSQLText[UpdateKind].Assign(Value);
146 < end;
147 <
148 < procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
149 < begin
150 <  SetSQL(TUpdateKind(Index), Value);
151 < end;
152 <
153 < procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
154 < var
155 <  UpdateKind: TUpdateKind;
156 < begin
157 <  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
158 <    if Sender = FSQLText[UpdateKind] then
159 <    begin
160 <      if Assigned(FQueries[UpdateKind]) then
161 <      begin
162 <        FQueries[UpdateKind].Params.Clear;
163 <        FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
164 <      end;
165 <      Break;
166 <    end;
167 < end;
168 <
169 < procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
170 < var
171 <  I: Integer;
172 <  Old: Boolean;
173 <  Param: TParam;
174 <  PName: string;
175 <  Field: TField;
176 <  Value: Variant;
177 < begin
178 <  if not Assigned(FDataSet) then Exit;
179 <  with Query[UpdateKind] do
180 <  begin
181 <    for I := 0 to Params.Count - 1 do
182 <    begin
183 <      Param := Params[I];
184 <      PName := Param.Name;
185 <      Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
186 <      if Old then
187 <        System.Delete(PName, 1, 4);
188 <      Field := FDataSet.FindField(PName);
189 <      if not Assigned(Field) then
190 <        Continue;
191 <      if Old then
192 <        Param.AssignFieldValue(Field, Field.OldValue) else
193 <      begin
194 <        Value := Field.NewValue;
195 <        if VarIsEmpty(Value) then
196 <          Value := Field.OldValue;
197 <        Param.AssignFieldValue(Field, Value);
198 <      end;
199 <    end;
200 <  end;
201 < end;
202 <
203 < procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
204 < begin
205 <  SetParams(UpdateKind);
206 <  ExecSQL(UpdateKind);
207 < end;
208 <
209 < end.
1 > {************************************************************************}
2 > {                                                                        }
3 > {       Borland Delphi Visual Component Library                          }
4 > {       InterBase Express core components                                }
5 > {                                                                        }
6 > {       Copyright (c) 1998-2000 Inprise Corporation                      }
7 > {                                                                        }
8 > {    InterBase Express is based in part on the product                   }
9 > {    Free IB Components, written by Gregory H. Deatz for                 }
10 > {    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
11 > {    Free IB Components is used under license.                           }
12 > {                                                                        }
13 > {    The contents of this file are subject to the InterBase              }
14 > {    Public License Version 1.0 (the "License"); you may not             }
15 > {    use this file except in compliance with the License. You            }
16 > {    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 > {    Software distributed under the License is distributed on            }
18 > {    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
19 > {    express or implied. See the License for the specific language       }
20 > {    governing rights and limitations under the License.                 }
21 > {    The Original Code was created by InterBase Software Corporation     }
22 > {       and its successors.                                              }
23 > {    Portions created by Inprise Corporation are Copyright (C) Inprise   }
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 SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL;
41 >
42 > type
43 > { TIBUpdateSQL }
44 >
45 >  TIBUpdateSQL = class(TIBDataSetUpdateObject)
46 >  private
47 >    FDataSet: TIBCustomDataSet;
48 >    FQueries: array[TUpdateKind] of TIBSQL;
49 >    FSQLText: array[TUpdateKind] of TStrings;
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);
62 >  public
63 >    constructor Create(AOwner: TComponent); override;
64 >    destructor Destroy; override;
65 >    property DataSet;
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;
70 >    property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
71 >    property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
72 >  end;
73 >
74 > implementation
75 >
76 > uses Variants;
77 >
78 > { TIBUpdateSQL }
79 >
80 > constructor TIBUpdateSQL.Create(AOwner: TComponent);
81 > var
82 >  UpdateKind: TUpdateKind;
83 > begin
84 >  inherited Create(AOwner);
85 >  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
86 >  begin
87 >    FSQLText[UpdateKind] := TStringList.Create;
88 >    TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
89 >  end;
90 > end;
91 >
92 > destructor TIBUpdateSQL.Destroy;
93 > var
94 >  UpdateKind: TUpdateKind;
95 > begin
96 >  if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
97 >    FDataSet.UpdateObject := nil;
98 >  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
99 >    FSQLText[UpdateKind].Free;
100 >  inherited Destroy;
101 > end;
102 >
103 > procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
104 > begin
105 >  InternalPrepare(UpdateKind);
106 >  with Query[UpdateKind] do
107 >  begin
108 >    ExecQuery;
109 >    if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
110 >  end;
111 > end;
112 >
113 > function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
114 > begin
115 >  if not Assigned(FQueries[UpdateKind]) then
116 >  begin
117 >    FQueries[UpdateKind] := TIBSQL.Create(Self);
118 >    FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
119 >    if (FDataSet is TIBCustomDataSet) then
120 >    begin
121 >      FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
122 >      FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
123 >    end;
124 >  end;
125 >  Result := FQueries[UpdateKind];
126 > end;
127 >
128 > function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
129 > begin
130 >  Result := FSQLText[UpdateKind];
131 > end;
132 >
133 > function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
134 > begin
135 >  Result := FSQLText[TUpdateKind(Index)];
136 > end;
137 >
138 > function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
139 > begin
140 >  Result := FDataSet;
141 > end;
142 >
143 > procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
144 > begin
145 >  FDataSet := ADataSet;
146 > end;
147 >
148 > procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
149 > begin
150 >  FSQLText[UpdateKind].Assign(Value);
151 > end;
152 >
153 > procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
154 > begin
155 >  SetSQL(TUpdateKind(Index), Value);
156 > end;
157 >
158 > procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
159 > begin
160 >  with Query[UpdateKind] do
161 >  begin
162 >    with Transaction do
163 >      if not InTransaction then StartTransaction;
164 >    if not Prepared then Prepare;
165 >  end;
166 > end;
167 >
168 > procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
169 > var
170 >  UpdateKind: TUpdateKind;
171 > begin
172 >  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
173 >    if Sender = FSQLText[UpdateKind] then
174 >    begin
175 >      if Assigned(FQueries[UpdateKind]) then
176 >        FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
177 >      Break;
178 >    end;
179 > end;
180 >
181 > procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
182 > begin
183 >  if not Assigned(FDataSet) then Exit;
184 >  InternalPrepare(UpdateKind);
185 >  InternalSetParams(Query[UpdateKind],buff);
186 >  ExecSQL(UpdateKind);
187 > end;
188 >
189 > end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines