ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBUpdateSQL.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 7379 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
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 - 2018 }
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 FLastUpdateKind :TUpdateKind;
49 FQueries: array[TUpdateKind] of TIBSQL;
50 FSQLText: array[TUpdateKind] of TStrings;
51 function GetQuery(UpdateKind: TUpdateKind): TIBSQL;
52 function GetSQLIndex(Index: Integer): TStrings;
53 procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
54 procedure SetSQLIndex(Index: Integer; Value: TStrings);
55 protected
56 procedure InternalPrepare(UpdateKind: TUpdateKind);
57 function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
58 function GetDataSet: TIBCustomDataSet; override;
59 procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
60 procedure SQLChanged(Sender: TObject);
61 procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override;
62 procedure ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
63 public
64 constructor Create(AOwner: TComponent); override;
65 destructor Destroy; override;
66 function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
67 DeleteCount: integer): boolean; override;
68 property DataSet;
69 property Query[UpdateKind: TUpdateKind]: TIBSQL read GetQuery;
70 property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
71 published
72 property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
73 property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
74 property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
75 end;
76
77 implementation
78
79 uses Variants;
80
81 { TIBUpdateSQL }
82
83 constructor TIBUpdateSQL.Create(AOwner: TComponent);
84 var
85 UpdateKind: TUpdateKind;
86 begin
87 inherited Create(AOwner);
88 for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
89 begin
90 FSQLText[UpdateKind] := TStringList.Create;
91 TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
92 end;
93 end;
94
95 destructor TIBUpdateSQL.Destroy;
96 var
97 UpdateKind: TUpdateKind;
98 begin
99 if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
100 FDataSet.UpdateObject := nil;
101 for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
102 FSQLText[UpdateKind].Free;
103 inherited Destroy;
104 end;
105
106 function TIBUpdateSQL.GetRowsAffected(var SelectCount, InsertCount,
107 UpdateCount, DeleteCount: integer): boolean;
108 begin
109 if Query[FLastUpdateKind].Statement <> nil then
110 Query[FLastUpdateKind].Statement.GetRowsAffected(SelectCount, InsertCount, UpdateCount, DeleteCount)
111 else
112 inherited;
113 end;
114
115 procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind; buff: PChar);
116 begin
117 InternalPrepare(UpdateKind);
118 with Query[UpdateKind] do
119 begin
120 ExecQuery;
121 // if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
122 // Commented out in release 1.2
123 if FieldCount > 0 then {Has RETURNING Clause}
124 UpdateRecordFromQuery(UpdateKind,Current,Buff);
125 end;
126 end;
127
128 function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL;
129 begin
130 if not Assigned(FQueries[UpdateKind]) then
131 begin
132 FQueries[UpdateKind] := TIBSQL.Create(Self);
133 FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
134 if (FDataSet is TIBCustomDataSet) then
135 begin
136 FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
137 FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
138 end;
139 end;
140 Result := FQueries[UpdateKind];
141 end;
142
143 function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
144 begin
145 Result := FSQLText[UpdateKind];
146 end;
147
148 function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
149 begin
150 Result := FSQLText[TUpdateKind(Index)];
151 end;
152
153 function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
154 begin
155 Result := FDataSet;
156 end;
157
158 procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
159 begin
160 FDataSet := ADataSet;
161 end;
162
163 procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
164 begin
165 FSQLText[UpdateKind].Assign(Value);
166 end;
167
168 procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
169 begin
170 SetSQL(TUpdateKind(Index), Value);
171 end;
172
173 procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind);
174 begin
175 with Query[UpdateKind] do
176 begin
177 with Transaction do
178 if not InTransaction then StartTransaction;
179 if not Prepared then Prepare;
180 end;
181 end;
182
183 procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
184 var
185 UpdateKind: TUpdateKind;
186 begin
187 for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
188 if Sender = FSQLText[UpdateKind] then
189 begin
190 if Assigned(FQueries[UpdateKind]) then
191 FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
192 Break;
193 end;
194 end;
195
196 procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar);
197 begin
198 if not Assigned(FDataSet) then Exit;
199 InternalPrepare(UpdateKind);
200 InternalSetParams(Query[UpdateKind].Params,buff);
201 ExecSQL(UpdateKind,buff);
202 FLastUpdateKind := UpdateKind;
203 end;
204
205 end.