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 (6 years, 7 months ago) by tony
File size: 6862 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line User Rev File contents
1 tony 17 {************************************************************************}
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.