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 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 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 < // Commented out in release 1.2
111 <  end;
112 < end;
113 <
114 < function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
115 < begin
116 <  if not Assigned(FQueries[UpdateKind]) then
117 <  begin
118 <    FQueries[UpdateKind] := TIBSQL.Create(Self);
119 <    FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
120 <    if (FDataSet is TIBCustomDataSet) then
121 <    begin
122 <      FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
123 <      FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
124 <    end;
125 <  end;
126 <  Result := FQueries[UpdateKind];
127 < end;
128 <
129 < function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
130 < begin
131 <  Result := FSQLText[UpdateKind];
132 < end;
133 <
134 < function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
135 < begin
136 <  Result := FSQLText[TUpdateKind(Index)];
137 < end;
138 <
139 < function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
140 < begin
141 <  Result := FDataSet;
142 < end;
143 <
144 < procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
145 < begin
146 <  FDataSet := ADataSet;
147 < end;
148 <
149 < procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
150 < begin
151 <  FSQLText[UpdateKind].Assign(Value);
152 < end;
153 <
154 < procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
155 < begin
156 <  SetSQL(TUpdateKind(Index), Value);
157 < end;
158 <
159 < procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
160 < begin
161 <  with Query[UpdateKind] do
162 <  begin
163 <    with Transaction do
164 <      if not InTransaction then StartTransaction;
165 <    if not Prepared then Prepare;
166 <  end;
167 < end;
168 <
169 < procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
170 < var
171 <  UpdateKind: TUpdateKind;
172 < begin
173 <  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
174 <    if Sender = FSQLText[UpdateKind] then
175 <    begin
176 <      if Assigned(FQueries[UpdateKind]) then
177 <        FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
178 <      Break;
179 <    end;
180 < end;
181 <
182 < procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
183 < begin
184 <  if not Assigned(FDataSet) then Exit;
185 <  InternalPrepare(UpdateKind);
186 <  InternalSetParams(Query[UpdateKind],buff);
187 <  ExecSQL(UpdateKind);
188 < end;
189 <
190 < 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 > // Commented out in release 1.2
111 >  end;
112 > end;
113 >
114 > function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
115 > begin
116 >  if not Assigned(FQueries[UpdateKind]) then
117 >  begin
118 >    FQueries[UpdateKind] := TIBSQL.Create(Self);
119 >    FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
120 >    if (FDataSet is TIBCustomDataSet) then
121 >    begin
122 >      FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
123 >      FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
124 >    end;
125 >  end;
126 >  Result := FQueries[UpdateKind];
127 > end;
128 >
129 > function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
130 > begin
131 >  Result := FSQLText[UpdateKind];
132 > end;
133 >
134 > function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
135 > begin
136 >  Result := FSQLText[TUpdateKind(Index)];
137 > end;
138 >
139 > function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
140 > begin
141 >  Result := FDataSet;
142 > end;
143 >
144 > procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
145 > begin
146 >  FDataSet := ADataSet;
147 > end;
148 >
149 > procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
150 > begin
151 >  FSQLText[UpdateKind].Assign(Value);
152 > end;
153 >
154 > procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
155 > begin
156 >  SetSQL(TUpdateKind(Index), Value);
157 > end;
158 >
159 > procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
160 > begin
161 >  with Query[UpdateKind] do
162 >  begin
163 >    with Transaction do
164 >      if not InTransaction then StartTransaction;
165 >    if not Prepared then Prepare;
166 >  end;
167 > end;
168 >
169 > procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
170 > var
171 >  UpdateKind: TUpdateKind;
172 > begin
173 >  for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
174 >    if Sender = FSQLText[UpdateKind] then
175 >    begin
176 >      if Assigned(FQueries[UpdateKind]) then
177 >        FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
178 >      Break;
179 >    end;
180 > end;
181 >
182 > procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
183 > begin
184 >  if not Assigned(FDataSet) then Exit;
185 >  InternalPrepare(UpdateKind);
186 >  InternalSetParams(Query[UpdateKind].Params,buff);
187 >  ExecSQL(UpdateKind);
188 > end;
189 >
190 > end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines