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 21 by tony, Thu Feb 26 10:33:34 2015 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	>	// 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.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines