ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/IBUpdateSQL.pas

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