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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 19 by tony, Mon Jul 7 13:00:15 2014 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	<	interface
32	<
33	<	uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
34	<	IB, IBCustomDataSet, IBQuery;
35	<
36	<	type
37	<	{ TIBUpdateSQL }
38	<
39	<	TIBUpdateSQL = class(TIBDataSetUpdateObject)
40	<	private
41	<	FDataSet: TIBCustomDataSet;
42	<	FQueries: array[TUpdateKind] of TIBQuery;
43	<	FSQLText: array[TUpdateKind] of TStrings;
44	<	function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
45	<	function GetSQLIndex(Index: Integer): TStrings;
46	<	procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
47	<	procedure SetSQLIndex(Index: Integer; Value: TStrings);
48	<	protected
49	<	function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
50	<	function GetDataSet: TIBCustomDataSet; override;
51	<	procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
52	<	procedure SQLChanged(Sender: TObject);
53	<	public
54	<	constructor Create(AOwner: TComponent); override;
55	<	destructor Destroy; override;
56	<	procedure Apply(UpdateKind: TUpdateKind); override;
57	<	procedure ExecSQL(UpdateKind: TUpdateKind);
58	<	procedure SetParams(UpdateKind: TUpdateKind);
59	<	property DataSet;
60	<	property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
61	<	property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
62	<	published
63	<	property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
64	<	property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
65	<	property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
66	<	end;
67	<
68	<	implementation
69	<
70	<	{ TIBUpdateSQL }
71	<
72	<	constructor TIBUpdateSQL.Create(AOwner: TComponent);
73	<	var
74	<	UpdateKind: TUpdateKind;
75	<	begin
76	<	inherited Create(AOwner);
77	<	for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
78	<	begin
79	<	FSQLText[UpdateKind] := TStringList.Create;
80	<	TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
81	<	end;
82	<	end;
83	<
84	<	destructor TIBUpdateSQL.Destroy;
85	<	var
86	<	UpdateKind: TUpdateKind;
87	<	begin
88	<	if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
89	<	FDataSet.UpdateObject := nil;
90	<	for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
91	<	FSQLText[UpdateKind].Free;
92	<	inherited Destroy;
93	<	end;
94	<
95	<	procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
96	<	begin
97	<	with Query[UpdateKind] do
98	<	begin
99	<	Prepare;
100	<	ExecSQL;
101	<	if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
102	<	end;
103	<	end;
104	<
105	<	function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
106	<	begin
107	<	if not Assigned(FQueries[UpdateKind]) then
108	<	begin
109	<	FQueries[UpdateKind] := TIBQuery.Create(Self);
110	<	FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
111	<	if (FDataSet is TIBCustomDataSet) then
112	<	begin
113	<	FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
114	<	FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
115	<	end;
116	<	end;
117	<	Result := FQueries[UpdateKind];
118	<	end;
119	<
120	<	function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
121	<	begin
122	<	Result := FSQLText[UpdateKind];
123	<	end;
124	<
125	<	function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
126	<	begin
127	<	Result := FSQLText[TUpdateKind(Index)];
128	<	end;
129	<
130	<	function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
131	<	begin
132	<	Result := FDataSet;
133	<	end;
134	<
135	<	procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
136	<	begin
137	<	FDataSet := ADataSet;
138	<	end;
139	<
140	<	procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
141	<	begin
142	<	FSQLText[UpdateKind].Assign(Value);
143	<	end;
144	<
145	<	procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
146	<	begin
147	<	SetSQL(TUpdateKind(Index), Value);
148	<	end;
149	<
150	<	procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
151	<	var
152	<	UpdateKind: TUpdateKind;
153	<	begin
154	<	for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
155	<	if Sender = FSQLText[UpdateKind] then
156	<	begin
157	<	if Assigned(FQueries[UpdateKind]) then
158	<	begin
159	<	FQueries[UpdateKind].Params.Clear;
160	<	FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
161	<	end;
162	<	Break;
163	<	end;
164	<	end;
165	<
166	<	procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
167	<	var
168	<	I: Integer;
169	<	Old: Boolean;
170	<	Param: TParam;
171	<	PName: string;
172	<	Field: TField;
173	<	Value: Variant;
174	<	begin
175	<	if not Assigned(FDataSet) then Exit;
176	<	with Query[UpdateKind] do
177	<	begin
178	<	for I := 0 to Params.Count - 1 do
179	<	begin
180	<	Param := Params[I];
181	<	PName := Param.Name;
182	<	Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
183	<	if Old then
184	<	System.Delete(PName, 1, 4);
185	<	Field := FDataSet.FindField(PName);
186	<	if not Assigned(Field) then
187	<	Continue;
188	<	if Old then
189	<	Param.AssignFieldValue(Field, Field.OldValue) else
190	<	begin
191	<	Value := Field.NewValue;
192	<	if VarIsEmpty(Value) then
193	<	Value := Field.OldValue;
194	<	Param.AssignFieldValue(Field, Value);
195	<	end;
196	<	end;
197	<	end;
198	<	end;
199	<
200	<	procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
201	<	begin
202	<	SetParams(UpdateKind);
203	<	ExecSQL(UpdateKind);
204	<	end;
205	<
206	<	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