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 7 by tony, Sun Aug 5 18:28:19 2012 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 < {    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.
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