ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUpdateSQL.pas
Revision: 21
Committed: Thu Feb 26 10:33:34 2015 UTC (9 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 6896 byte(s)
Log Message:
Committing updates for Release R1-2-0

File Contents

# User Rev Content
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 tony 21 // if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
110     // Commented out in release 1.2
111 tony 17 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],buff);
187     ExecSQL(UpdateKind);
188     end;
189    
190 tony 19 end.