--- ibx/trunk/runtime/IBUpdateSQL.pas 2013/02/28 16:56:14 16 +++ ibx/trunk/runtime/IBUpdateSQL.pas 2013/12/28 19:22:24 17 @@ -1,189 +1,189 @@ -{************************************************************************} -{ } -{ Borland Delphi Visual Component Library } -{ InterBase Express core components } -{ } -{ Copyright (c) 1998-2000 Inprise Corporation } -{ } -{ InterBase Express is based in part on the product } -{ Free IB Components, written by Gregory H. Deatz for } -{ Hoagland, Longo, Moran, Dunst & Doukas Company. } -{ Free IB Components is used under license. } -{ } -{ The contents of this file are subject to the InterBase } -{ Public License Version 1.0 (the "License"); you may not } -{ use this file except in compliance with the License. You } -{ may obtain a copy of the License at http://www.Inprise.com/IPL.html } -{ Software distributed under the License is distributed on } -{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either } -{ express or implied. See the License for the specific language } -{ governing rights and limitations under the License. } -{ The Original Code was created by InterBase Software Corporation } -{ and its successors. } -{ Portions created by Inprise Corporation are Copyright (C) Inprise } -{ Corporation. All Rights Reserved. } -{ Contributor(s): Jeff Overcash } -{ } -{ IBX For Lazarus (Firebird Express) } -{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk } -{ Portions created by MWA Software are copyright McCallum Whyman } -{ Associates Ltd 2011 } -{ } -{************************************************************************} - -unit IBUpdateSQL; - -{$Mode Delphi} - -interface - -uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL; - -type -{ TIBUpdateSQL } - - TIBUpdateSQL = class(TIBDataSetUpdateObject) - private - FDataSet: TIBCustomDataSet; - FQueries: array[TUpdateKind] of TIBSQL; - FSQLText: array[TUpdateKind] of TStrings; - function GetQuery(UpdateKind: TUpdateKind): TIBSQL; - function GetSQLIndex(Index: Integer): TStrings; - procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings); - procedure SetSQLIndex(Index: Integer; Value: TStrings); - protected - procedure InternalPrepare(UpdateKind: TUpdateKind); - function GetSQL(UpdateKind: TUpdateKind): TStrings; override; - function GetDataSet: TIBCustomDataSet; override; - procedure SetDataSet(ADataSet: TIBCustomDataSet); override; - procedure SQLChanged(Sender: TObject); - procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override; - procedure ExecSQL(UpdateKind: TUpdateKind); - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property DataSet; - property Query[UpdateKind: TUpdateKind]: TIBSQL read GetQuery; - property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL; - published - property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex; - property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex; - property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex; - end; - -implementation - -uses Variants; - -{ TIBUpdateSQL } - -constructor TIBUpdateSQL.Create(AOwner: TComponent); -var - UpdateKind: TUpdateKind; -begin - inherited Create(AOwner); - for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do - begin - FSQLText[UpdateKind] := TStringList.Create; - TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged; - end; -end; - -destructor TIBUpdateSQL.Destroy; -var - UpdateKind: TUpdateKind; -begin - if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then - FDataSet.UpdateObject := nil; - for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do - FSQLText[UpdateKind].Free; - inherited Destroy; -end; - -procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind); -begin - InternalPrepare(UpdateKind); - with Query[UpdateKind] do - begin - ExecQuery; - if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]); - end; -end; - -function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL; -begin - if not Assigned(FQueries[UpdateKind]) then - begin - FQueries[UpdateKind] := TIBSQL.Create(Self); - FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]); - if (FDataSet is TIBCustomDataSet) then - begin - FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase; - FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction; - end; - end; - Result := FQueries[UpdateKind]; -end; - -function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings; -begin - Result := FSQLText[UpdateKind]; -end; - -function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings; -begin - Result := FSQLText[TUpdateKind(Index)]; -end; - -function TIBUpdateSQL.GetDataSet: TIBCustomDataSet; -begin - Result := FDataSet; -end; - -procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet); -begin - FDataSet := ADataSet; -end; - -procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings); -begin - FSQLText[UpdateKind].Assign(Value); -end; - -procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings); -begin - SetSQL(TUpdateKind(Index), Value); -end; - -procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind); -begin - with Query[UpdateKind] do - begin - with Transaction do - if not InTransaction then StartTransaction; - if not Prepared then Prepare; - end; -end; - -procedure TIBUpdateSQL.SQLChanged(Sender: TObject); -var - UpdateKind: TUpdateKind; -begin - for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do - if Sender = FSQLText[UpdateKind] then - begin - if Assigned(FQueries[UpdateKind]) then - FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]); - Break; - end; -end; - -procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar); -begin - if not Assigned(FDataSet) then Exit; - InternalPrepare(UpdateKind); - InternalSetParams(Query[UpdateKind],buff); - ExecSQL(UpdateKind); -end; - -end. +{************************************************************************} +{ } +{ Borland Delphi Visual Component Library } +{ InterBase Express core components } +{ } +{ Copyright (c) 1998-2000 Inprise Corporation } +{ } +{ InterBase Express is based in part on the product } +{ Free IB Components, written by Gregory H. Deatz for } +{ Hoagland, Longo, Moran, Dunst & Doukas Company. } +{ Free IB Components is used under license. } +{ } +{ The contents of this file are subject to the InterBase } +{ Public License Version 1.0 (the "License"); you may not } +{ use this file except in compliance with the License. You } +{ may obtain a copy of the License at http://www.Inprise.com/IPL.html } +{ Software distributed under the License is distributed on } +{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either } +{ express or implied. See the License for the specific language } +{ governing rights and limitations under the License. } +{ The Original Code was created by InterBase Software Corporation } +{ and its successors. } +{ Portions created by Inprise Corporation are Copyright (C) Inprise } +{ Corporation. All Rights Reserved. } +{ Contributor(s): Jeff Overcash } +{ } +{ IBX For Lazarus (Firebird Express) } +{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk } +{ Portions created by MWA Software are copyright McCallum Whyman } +{ Associates Ltd 2011 } +{ } +{************************************************************************} + +unit IBUpdateSQL; + +{$Mode Delphi} + +interface + +uses SysUtils, Classes, DB, IB, IBCustomDataSet, IBSQL; + +type +{ TIBUpdateSQL } + + TIBUpdateSQL = class(TIBDataSetUpdateObject) + private + FDataSet: TIBCustomDataSet; + FQueries: array[TUpdateKind] of TIBSQL; + FSQLText: array[TUpdateKind] of TStrings; + function GetQuery(UpdateKind: TUpdateKind): TIBSQL; + function GetSQLIndex(Index: Integer): TStrings; + procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings); + procedure SetSQLIndex(Index: Integer; Value: TStrings); + protected + procedure InternalPrepare(UpdateKind: TUpdateKind); + function GetSQL(UpdateKind: TUpdateKind): TStrings; override; + function GetDataSet: TIBCustomDataSet; override; + procedure SetDataSet(ADataSet: TIBCustomDataSet); override; + procedure SQLChanged(Sender: TObject); + procedure Apply(UpdateKind: TUpdateKind; buff: PChar); override; + procedure ExecSQL(UpdateKind: TUpdateKind); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property DataSet; + property Query[UpdateKind: TUpdateKind]: TIBSQL read GetQuery; + property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL; + published + property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex; + property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex; + property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex; + end; + +implementation + +uses Variants; + +{ TIBUpdateSQL } + +constructor TIBUpdateSQL.Create(AOwner: TComponent); +var + UpdateKind: TUpdateKind; +begin + inherited Create(AOwner); + for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do + begin + FSQLText[UpdateKind] := TStringList.Create; + TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged; + end; +end; + +destructor TIBUpdateSQL.Destroy; +var + UpdateKind: TUpdateKind; +begin + if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then + FDataSet.UpdateObject := nil; + for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do + FSQLText[UpdateKind].Free; + inherited Destroy; +end; + +procedure TIBUpdateSQL.ExecSQL(UpdateKind: TUpdateKind); +begin + InternalPrepare(UpdateKind); + with Query[UpdateKind] do + begin + ExecQuery; + if RowsAffected <> 1 then IBError(ibxeUpdateFailed, [nil]); + end; +end; + +function TIBUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TIBSQL; +begin + if not Assigned(FQueries[UpdateKind]) then + begin + FQueries[UpdateKind] := TIBSQL.Create(Self); + FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]); + if (FDataSet is TIBCustomDataSet) then + begin + FQueries[UpdateKind].Database := TIBCustomDataSet(FDataSet).DataBase; + FQueries[UpdateKind].Transaction := TIBCustomDataSet(FDataSet).Transaction; + end; + end; + Result := FQueries[UpdateKind]; +end; + +function TIBUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings; +begin + Result := FSQLText[UpdateKind]; +end; + +function TIBUpdateSQL.GetSQLIndex(Index: Integer): TStrings; +begin + Result := FSQLText[TUpdateKind(Index)]; +end; + +function TIBUpdateSQL.GetDataSet: TIBCustomDataSet; +begin + Result := FDataSet; +end; + +procedure TIBUpdateSQL.SetDataSet(ADataSet: TIBCustomDataSet); +begin + FDataSet := ADataSet; +end; + +procedure TIBUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings); +begin + FSQLText[UpdateKind].Assign(Value); +end; + +procedure TIBUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings); +begin + SetSQL(TUpdateKind(Index), Value); +end; + +procedure TIBUpdateSQL.InternalPrepare(UpdateKind: TUpdateKind); +begin + with Query[UpdateKind] do + begin + with Transaction do + if not InTransaction then StartTransaction; + if not Prepared then Prepare; + end; +end; + +procedure TIBUpdateSQL.SQLChanged(Sender: TObject); +var + UpdateKind: TUpdateKind; +begin + for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do + if Sender = FSQLText[UpdateKind] then + begin + if Assigned(FQueries[UpdateKind]) then + FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]); + Break; + end; +end; + +procedure TIBUpdateSQL.Apply(UpdateKind: TUpdateKind; buff: PChar); +begin + if not Assigned(FDataSet) then Exit; + InternalPrepare(UpdateKind); + InternalSetParams(Query[UpdateKind],buff); + ExecSQL(UpdateKind); +end; + +end.