ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUpdateSQL.pas
Revision: 1
Committed: Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 6853 byte(s)
Log Message:
Borland IBX Open Source Release

File Contents

# User Rev Content
1 tony 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     {************************************************************************}
28    
29     unit IBUpdateSQL;
30    
31     interface
32    
33     uses Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL,
34     IB, IBCustomDataSet, IBQuery;
35    
36     type
37     { TIBUpdateSQL }
38    
39     TIBUpdateSQL = class(TIBDataSetUpdateObject)
40     private
41     FDataSet: TIBCustomDataSet;
42     FQueries: array[TUpdateKind] of TIBQuery;
43     FSQLText: array[TUpdateKind] of TStrings;
44     function GetQuery(UpdateKind: TUpdateKind): TIBQuery;
45     function GetSQLIndex(Index: Integer): TStrings;
46     procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
47     procedure SetSQLIndex(Index: Integer; Value: TStrings);
48     protected
49     function GetSQL(UpdateKind: TUpdateKind): TStrings; override;
50     function GetDataSet: TIBCustomDataSet; override;
51     procedure SetDataSet(ADataSet: TIBCustomDataSet); override;
52     procedure SQLChanged(Sender: TObject);
53     public
54     constructor Create(AOwner: TComponent); override;
55     destructor Destroy; override;
56     procedure Apply(UpdateKind: TUpdateKind); override;
57     procedure ExecSQL(UpdateKind: TUpdateKind);
58     procedure SetParams(UpdateKind: TUpdateKind);
59     property DataSet;
60     property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery;
61     property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
62     published
63     property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
64     property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
65     property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
66     end;
67    
68     implementation
69    
70     { TIBUpdateSQL }
71    
72     constructor TIBUpdateSQL.Create(AOwner: TComponent);
73     var
74     UpdateKind: TUpdateKind;
75     begin
76     inherited Create(AOwner);
77     for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
78     begin
79     FSQLText[UpdateKind] := TStringList.Create;
80     TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
81     end;
82     end;
83    
84     destructor TIBUpdateSQL.Destroy;
85     var
86     UpdateKind: TUpdateKind;
87     begin
88     if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
89     FDataSet.UpdateObject := nil;
90     for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
91     FSQLText[UpdateKind].Free;
92     inherited Destroy;
93     end;
94    
95     procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
96     begin
97     with Query[UpdateKind] do
98     begin
99     Prepare;
100     ExecSQL;
101     if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]);
102     end;
103     end;
104    
105     function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery;
106     begin
107     if not Assigned(FQueries[UpdateKind]) then
108     begin
109     FQueries[UpdateKind] := TIBQuery.Create(Self);
110     FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
111     if (FDataSet is TIBCustomDataSet) then
112     begin
113     FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase;
114     FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction;
115     end;
116     end;
117     Result := FQueries[UpdateKind];
118     end;
119    
120     function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
121     begin
122     Result := FSQLText[UpdateKind];
123     end;
124    
125     function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
126     begin
127     Result := FSQLText[TUpdateKind(Index)];
128     end;
129    
130     function TIBUpdateSQL.GetDataSet: TIBCustomDataSet;
131     begin
132     Result := FDataSet;
133     end;
134    
135     procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet);
136     begin
137     FDataSet := ADataSet;
138     end;
139    
140     procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
141     begin
142     FSQLText[UpdateKind].Assign(Value);
143     end;
144    
145     procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
146     begin
147     SetSQL(TUpdateKind(Index), Value);
148     end;
149    
150     procedure TIBUpdateSQL.SQLChanged(Sender: TObject);
151     var
152     UpdateKind: TUpdateKind;
153     begin
154     for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
155     if Sender = FSQLText[UpdateKind] then
156     begin
157     if Assigned(FQueries[UpdateKind]) then
158     begin
159     FQueries[UpdateKind].Params.Clear;
160     FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
161     end;
162     Break;
163     end;
164     end;
165    
166     procedure TIBUpdateSQL.SetParams(UpdateKind: TUpdateKind);
167     var
168     I: Integer;
169     Old: Boolean;
170     Param: TParam;
171     PName: string;
172     Field: TField;
173     Value: Variant;
174     begin
175     if not Assigned(FDataSet) then Exit;
176     with Query[UpdateKind] do
177     begin
178     for I := 0 to Params.Count - 1 do
179     begin
180     Param := Params[I];
181     PName := Param.Name;
182     Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0; {do not localize}
183     if Old then
184     System.Delete(PName, 1, 4);
185     Field := FDataSet.FindField(PName);
186     if not Assigned(Field) then
187     Continue;
188     if Old then
189     Param.AssignFieldValue(Field, Field.OldValue) else
190     begin
191     Value := Field.NewValue;
192     if VarIsEmpty(Value) then
193     Value := Field.OldValue;
194     Param.AssignFieldValue(Field, Value);
195     end;
196     end;
197     end;
198     end;
199    
200     procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind);
201     begin
202     SetParams(UpdateKind);
203     ExecSQL(UpdateKind);
204     end;
205    
206     end.