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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 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	<	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; buff: PChar);
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; buff: PChar);
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	>	if FieldCount > 0 then  {Has RETURNING Clause}
112	>	UpdateRecordFromQuery(UpdateKind,Current,Buff);
113	>	end;
114	>	end;
115	>
116	>	function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
117	>	begin
118	>	if not Assigned(FQueries[UpdateKind]) then
119	>	begin
120	>	FQueries[UpdateKind] := TIBSQL.Create(Self);
121	>	FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
122	>	if (FDataSet is TIBCustomDataSet) then
123	>	begin
124	>	FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
125	>	FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
126	>	end;
127	>	end;
128	>	Result := FQueries[UpdateKind];
129	>	end;
130	>
131	>	function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
132	>	begin
133	>	Result := FSQLText[UpdateKind];
134	>	end;
135	>
136	>	function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
137	>	begin
138	>	Result := FSQLText[TUpdateKind(Index)];
139	>	end;
140	>
141	>	function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
142	>	begin
143	>	Result := FDataSet;
144	>	end;
145	>
146	>	procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
147	>	begin
148	>	FDataSet := ADataSet;
149	>	end;
150	>
151	>	procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
152	>	begin
153	>	FSQLText[UpdateKind].Assign(Value);
154	>	end;
155	>
156	>	procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
157	>	begin
158	>	SetSQL(TUpdateKind(Index), Value);
159	>	end;
160	>
161	>	procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
162	>	begin
163	>	with Query[UpdateKind] do
164	>	begin
165	>	with Transaction do
166	>	if not InTransaction then StartTransaction;
167	>	if not Prepared then Prepare;
168	>	end;
169	>	end;
170	>
171	>	procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
172	>	var
173	>	UpdateKind: TUpdateKind;
174	>	begin
175	>	for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
176	>	if Sender = FSQLText[UpdateKind] then
177	>	begin
178	>	if Assigned(FQueries[UpdateKind]) then
179	>	FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
180	>	Break;
181	>	end;
182	>	end;
183	>
184	>	procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
185	>	begin
186	>	if not Assigned(FDataSet) then Exit;
187	>	InternalPrepare(UpdateKind);
188	>	InternalSetParams(Query[UpdateKind].Params,buff);
189	>	ExecSQL(UpdateKind,buff);
190	>	end;
191	>
192	>	end.

Diff Legend

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