ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUpdateSQL.pas
Revision: 80
Committed: Mon Jan 1 11:31:07 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 6714 byte(s)
Log Message:
Fixes merged into public release

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 }
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].Params,buff);
187 ExecSQL(UpdateKind);
188 end;
189
190 end.