unit ADOUpdateSQL;<br><br>interface<br><br>uses<br> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br> Db, ADOInt, ADODB,Variants;<br><br>type<br> TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;<br> TADOUpdateSQL = class;<br><br> TADOUpdDataSet = class(TADODataSet)<br> private<br> { Private declarations }<br> FUpdateObject: TADOUpdateSQL;<br> FOnUpdateRecord: TUpdateRecordEvent;<br> fOnUpdateError: TUpdateErrorEvent;<br> procedure SetUpdateObject(Value: TADOUpdateSQL);<br> function UpdatePending(var UpdateKind: TUpdateKind): boolean;<br> protected<br> { Protected declarations }<br> procedure ApplyUpdates(AffectRecords: TAffectRecords);<br> public<br> { Public declarations }<br> procedure UpdateBatch(AffectRecords: TAffectRecords = arAll); reintroduce;<br> published<br> { Published declarations }<br> property UpdateObject: TADOUpdateSQL read FUpdateObject write SetUpdateObject;<br> { Events }<br> //property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord write FOnUpdateRecord;<br> property OnUpdateError: TUpdateErrorEvent read fOnUpdateError write fOnUpdateError;<br> end;<br><br> TADOUpdateSQL = class(TComponent)<br> private<br> { Private declarations }<br> FDataSet: TADOUpdDataSet;<br> FQueries: array[TUpdateKind] of TADOQuery;<br> FSQLText: array[TUpdateKind] of TStrings;<br> function GetQuery(UpdateKind: TUpdateKind): TADOQuery;<br> function GetSQL(UpdateKind: TUpdateKind): TStrings;<br> function GetSQLIndex(Index: Integer): TStrings;<br> procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);<br> procedure SetSQLIndex(Index: Integer; Value: TStrings);<br> protected<br> { Protected declarations }<br> function GetDataSet: TADOUpdDataSet;<br> procedure SetDataSet(ADataSet: TADOUpdDataSet);<br> procedure SQLChanged(Sender: TObject);<br> public<br> { Public declarations }<br> constructor Create(AOwner: TComponent); override;<br> destructor Destroy; override;<br> property DataSet: TADOUpdDataSet read GetDataSet write SetDataSet;<br> procedure Apply(UpdateKind: TUpdateKind);<br> procedure ExecSQL(UpdateKind: TUpdateKind);<br> procedure SetParams(UpdateKind: TUpdateKind);<br> property Query[UpdateKind: TUpdateKind]: TADOQuery read GetQuery;<br> property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;<br> published<br> { Published declarations }<br> property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;<br> property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;<br> property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;<br> end;<br><br>procedure Register;<br><br>implementation<br><br>resourcestring<br> rsUpdateFailed = 'Update failed';<br><br>procedure Register;<br>begin<br> RegisterComponents('FreDsterWare', [TADOUpdDataSet, TADOUpdateSQL]);<br>end;<br><br>{ TADOUpdDataSet }<br><br>{-----------------------------------------------------<br> TADOUpdDataSet.SetUpdateObject<br><br> * Purpose : Set the UpdateObject<br> If another dataset already references this updateobject, then remove the reference<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdDataSet.SetUpdateObject(Value: TADOUpdateSQL);<br>begin<br> if Value <> FUpdateObject then<br> begin<br> if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then<br> FUpdateObject.DataSet := nil;<br> FUpdateObject := Value;<br> if Assigned(FUpdateObject) then<br> begin<br> if Assigned(FUpdateObject.DataSet) and<br> (FUpdateObject.DataSet <> Self) then<br> FUpdateObject.DataSet.UpdateObject := nil;<br> FUpdateObject.DataSet := Self;<br> end;<br> end;<br>end;<br>{-----------------------------------------------------<br> TADOUpdDataSet.UpdateBatch<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdDataSet.UpdateBatch(AffectRecords: TAffectRecords);<br>begin<br> if Assigned(FUpdateObject)<br> or Assigned(FOnUpdateRecord) then<br> ApplyUpdates(AffectRecords)<br> else<br> inherited UpdateBatch(AffectRecords);<br>end;<br>{-----------------------------------------------------<br> TADOUpdDataSet.ApplyUpdates<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdDataSet.ApplyUpdates(AffectRecords: TAffectRecords);<br>var<br> UpdateAction : TUpdateAction;<br> UpdateKind : TUpdateKind;<br> SavedFilter : string;<br> SavedFilterGroup : TFilterGroup;<br> wasFiltered : Boolean;<br><br> RequeryNeeded : Boolean;<br>begin<br><br> SavedFilter := Filter;<br> SavedFilterGroup := FilterGroup;<br> wasFiltered := Filtered;<br> FilterGroup := fgNone;<br> RequeryNeeded := False;<br><br> CheckBrowseMode;<br> if not isEmpty then<br> begin<br> DisableControls;<br> try<br> UpdateCursorPos;<br> if not (RecordSet.EOF and RecordSet.BOF) then<br> begin<br> RecordSet.Filter := adFilterPendingRecords;<br> if not (RecordSet.EOF and RecordSet.BOF) then<br> begin<br> RecordSet.MoveFirst;<br> while not RecordSet.Eof do<br> begin<br> if (Recordset.Status and adRecDeleted) = adRecDeleted then<br> begin<br> UpdateAction := uaFail;<br> UpdateKind := ukDelete;<br> try<br> RequeryNeeded := True;<br> Recordset.CancelBatch(adAffectCurrent);<br> FUpdateObject.Apply(UpdateKind);<br> except<br> on E: EDatabaseError do<br> if Assigned(OnUpdateError) then<br> OnUpdateError(Self, E, UpdateKind, UpdateAction)<br> end;<br> end;<br> RecordSet.MoveNext;<br> end;<br> end;<br> RecordSet.Filter := adFilterPendingRecords;<br> end;<br><br> FilterGroup := fgPendingRecords;<br> Filtered := true;<br> if not (EOF and BOF) then<br> begin<br> First;<br> while not Eof do<br> begin<br> UpdateCursorPos;<br> if UpdatePending(UpdateKind) then<br> begin<br> RequeryNeeded := RequeryNeeded or (UpdateKind <> ukModify);<br> UpdateAction := uaFail;<br> if Assigned(FOnUpdateRecord) then<br> FOnUpdateRecord(self, UpdateKind, UpdateAction)<br> else<br> begin<br> try<br> FUpdateObject.Apply(UpdateKind);<br> except<br> on E: EDatabaseError do<br> if Assigned(OnUpdateError) then<br> OnUpdateError(Self, E, UpdateKind, UpdateAction)<br> end;<br> Recordset.CancelBatch(adAffectCurrent);<br> end;<br> end;<br> Next;<br> end;<br> end;<br> finally<br> FilterGroup := fgNone;<br> FilterGroup := SavedFilterGroup;<br> Filter := SavedFilter;<br> Filtered := wasFiltered;<br><br> if RequeryNeeded then<br> Requery<br> else<br> Refresh;<br> EnableControls;<br> end;<br> end;<br>end;<br>{-----------------------------------------------------<br> TADOUpdDataSet.UpdatePending<br><br> * Purpose : Map UpdateStatus to UpdateKind<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>function TADOUpdDataSet.UpdatePending(var UpdateKind: TUpdateKind): boolean;<br>var<br> AUpdateStatus : TUpdateStatus;<br>begin<br> AUpdateStatus := UpdateStatus;<br> Result := (AUpdateStatus <> usUnmodified);<br> if Result then<br> UpdateKind := TUpdateKind(Ord(AUpdateStatus) - 1);<br>end;<br><br>{ TADOUpdateSQL }<br><br>{-----------------------------------------------------<br> TADOUpdateSQL.Apply<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.Apply(UpdateKind: TUpdateKind);<br>begin<br> SetParams(UpdateKind);<br> ExecSQL(UpdateKind);<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.Create<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>constructor TADOUpdateSQL.Create(AOwner: TComponent);<br>var<br> UpdateKind : TUpdateKind;<br>begin<br> inherited Create(AOwner);<br> for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do<br> begin<br> FSQLText[UpdateKind] := TStringList.Create;<br> TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;<br> end;<br><br>{$IFDEF UNREGISTERED}<br> if not (csDesigning in ComponentState) then { running outside IDE}<br> if (FindWindowEx(0, 0, 'TAppBuilder', nil) = 0) then<br> begin { Delphi not found}<br> Application.NormalizeTopMosts;<br> ShowMessage(Self.ClassName + ' is NOT a public domain product, if you find it usefull then please register it..');<br> Application.RestoreTopMosts;<br> end;<br>{$ENDIF}<br><br>end;<br><br>{-----------------------------------------------------<br> TADOUpdateSQL.Destroy<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>destructor TADOUpdateSQL.Destroy;<br>var<br> UpdateKind : TUpdateKind;<br>begin<br> if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then<br> FDataSet.UpdateObject := nil;<br> for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do<br> FSQLText[UpdateKind].Free;<br> inherited Destroy;<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.ExecSQL<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);<br>begin<br> with Query[UpdateKind] do<br> begin<br> Prepared := True;<br> ExecSQL;<br> if (RowsAffected = 0) then<br> DatabaseError(rsUpdateFailed);<br> end;<br>end;<br><br>{-----------------------------------------------------<br> TADOUpdateSQL.GetQuery<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>function TADOUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TADOQuery;<br>begin<br> if not Assigned(FQueries[UpdateKind]) then<br> begin<br> FQueries[UpdateKind] := TADOQuery.Create(Self);<br> FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);<br> if Assigned(FDataSet.Connection) then<br> FQueries[UpdateKind].Connection := FDataSet.Connection<br> else<br> FQueries[UpdateKind].ConnectionString := FDataSet.ConnectionString;<br> end;<br> Result := FQueries[UpdateKind];<br>end;<br><br>{-----------------------------------------------------<br> TADOUpdateSQL.GetSQL<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>function TADOUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;<br>begin<br> Result := FSQLText[UpdateKind];<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.GetSQLIndex<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>function TADOUpdateSQL.GetSQLIndex(Index: Integer): TStrings;<br>begin<br> Result := FSQLText[TUpdateKind(Index)];<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.GetDataSet<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>function TADOUpdateSQL.GetDataSet: TADOUpdDataSet;<br>begin<br> Result := FDataSet;<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.SetDataSet<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.SetDataSet(ADataSet: TADOUpdDataSet);<br>begin<br> FDataSet := ADataSet;<br>end;<br><br>{-----------------------------------------------------<br> TADOUpdateSQL.SetParams<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.SetParams(UpdateKind: TUpdateKind);<br>var<br> I : Integer;<br> isOld : Boolean;<br> Parameter : TParameter;<br> ParameterName : string;<br> AValue : Variant;<br> ADOField : OleVariant;<br>begin<br> if not Assigned(FDataSet) then Exit;<br><br> with Query[UpdateKind] do<br> begin<br> Parameters.ParseSQL(SQL.Text, True);<br> for I := 0 to Parameters.Count - 1 do<br> begin<br> Parameter := Parameters.Items;<br> ParameterName := Parameter.Name;<br> isOld := CompareText(Copy(ParameterName, 1, 4), 'OLD_') = 0;<br> if isOld then<br> System.Delete(ParameterName, 1, 4);<br> if not Assigned(FDataSet.FindField(ParameterName)) then<br> Continue;<br><br> ADOField := FDataSet.Recordset.Fields[ParameterName];<br> if isOld then<br> AValue := ADOField.OriginalValue<br> else<br> if VarIsEmpty(ADOField.Value) or VarIsNull(ADOField.Value) then<br> begin<br> Parameter.ParameterObject.Type_ := FDataSet.Recordset.Fields[ParameterName].Type_;<br> AValue := NULL;<br> end<br> else<br> AValue := ADOField.Value;<br> Parameter.Value := AValue;<br> end;<br> end;<br><br>end;<br><br>{-----------------------------------------------------<br> TADOUpdateSQL.SetSQL<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);<br>begin<br> FSQLText[UpdateKind].Assign(Value);<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.SetSQLIndex<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);<br>begin<br> SetSQL(TUpdateKind(Index), Value);<br>end;<br>{-----------------------------------------------------<br> TADOUpdateSQL.SQLChanged<br><br> * Purpose :<br> * Author : Fred Schetterer<br> * History :<br> 12-Mar-2000 - Created<br>--------------------------------------------------------}<br><br>procedure TADOUpdateSQL.SQLChanged(Sender: TObject);<br>var<br> UpdateKind : TUpdateKind;<br>begin<br> for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do<br> if Sender = FSQLText[UpdateKind] then<br> begin<br> if Assigned(FQueries[UpdateKind]) then<br> begin<br> FQueries[UpdateKind].Parameters.Clear;<br> FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);<br> end;<br> Break;<br> end;<br>end;<br><br>end.