| 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 Windows, SysUtils, Graphics, Classes, Controls, Db, StdVCL, |
| 34 |
< |
IB, IBCustomDataSet, IBQuery; |
| 40 |
> |
uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL; |
| 41 |
|
|
| 42 |
|
type |
| 43 |
|
{ TIBUpdateSQL } |
| 45 |
|
TIBUpdateSQL = class(TIBDataSetUpdateObject) |
| 46 |
|
private |
| 47 |
|
FDataSet: TIBCustomDataSet; |
| 48 |
< |
FQueries: array[TUpdateKind] of TIBQuery; |
| 48 |
> |
FQueries: array[TUpdateKind] of TIBSQL; |
| 49 |
|
FSQLText: array[TUpdateKind] of TStrings; |
| 50 |
< |
function GetQuery(UpdateKind: TUpdateKind): TIBQuery; |
| 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; |
| 56 |
– |
procedure Apply(UpdateKind: TUpdateKind); override; |
| 57 |
– |
procedure ExecSQL(UpdateKind: TUpdateKind); |
| 58 |
– |
procedure SetParams(UpdateKind: TUpdateKind); |
| 65 |
|
property DataSet; |
| 66 |
< |
property Query[UpdateKind: TUpdateKind]: TIBQuery read GetQuery; |
| 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; |
| 73 |
|
|
| 74 |
|
implementation |
| 75 |
|
|
| 76 |
+ |
uses Variants; |
| 77 |
+ |
|
| 78 |
|
{ TIBUpdateSQL } |
| 79 |
|
|
| 80 |
|
constructor TIBUpdateSQL.Create(AOwner: TComponent); |
| 102 |
|
|
| 103 |
|
procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind); |
| 104 |
|
begin |
| 105 |
+ |
InternalPrepare(UpdateKind); |
| 106 |
|
with Query[UpdateKind] do |
| 107 |
|
begin |
| 108 |
< |
Prepare; |
| 100 |
< |
ExecSQL; |
| 108 |
> |
ExecQuery; |
| 109 |
|
if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]); |
| 110 |
|
end; |
| 111 |
|
end; |
| 112 |
|
|
| 113 |
< |
function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBQuery; |
| 113 |
> |
function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL; |
| 114 |
|
begin |
| 115 |
|
if not Assigned(FQueries[UpdateKind]) then |
| 116 |
|
begin |
| 117 |
< |
FQueries[UpdateKind] := TIBQuery.Create(Self); |
| 117 |
> |
FQueries[UpdateKind] := TIBSQL.Create(Self); |
| 118 |
|
FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]); |
| 119 |
|
if (FDataSet is TIBCustomDataSet) then |
| 120 |
|
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; |
| 173 |
|
if Sender = FSQLText[UpdateKind] then |
| 174 |
|
begin |
| 175 |
|
if Assigned(FQueries[UpdateKind]) then |
| 158 |
– |
begin |
| 159 |
– |
FQueries[UpdateKind].Params.Clear; |
| 176 |
|
FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]); |
| 161 |
– |
end; |
| 177 |
|
Break; |
| 178 |
|
end; |
| 179 |
|
end; |
| 180 |
|
|
| 181 |
< |
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; |
| 181 |
> |
procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar); |
| 182 |
|
begin |
| 183 |
|
if not Assigned(FDataSet) then Exit; |
| 184 |
< |
with Query[UpdateKind] do |
| 185 |
< |
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); |
| 184 |
> |
InternalPrepare(UpdateKind); |
| 185 |
> |
InternalSetParams(Query[UpdateKind],buff); |
| 186 |
|
ExecSQL(UpdateKind); |
| 187 |
|
end; |
| 188 |
|
|
