ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUpdateSQL.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (10 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 6862 byte(s)
Log Message:
Committing updates for Release R1-0-5

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 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.