ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUpdateSQL.pas
Revision: 118
Committed: Mon Jan 22 13:58:14 2018 UTC (2 years, 1 month ago) by tony
File size: 6850 byte(s)
Log Message:
Fixes Merged
Line File contents
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.