Title: Referential Integrity component for DBISAM (w/ Bug fixed)
Question: How to add referential integrity with cascade / update
delete by using component ?
Answer:
{ TCASCADE COMPONENT FOR DBISAM 1.21
PUBLIC DOMAIN RELEASE ON 26 APRIL 2000 BY JIRAYU WIRIYAPHIBOOL
MODIFIED AND IMPROVED BY ......
FREELY USE OR MODIFY AT YOUR OWN RISK
CONTACT ME AT : JIRAYU@SUNNCITY.COM
VISIT MY WEBSITE WWW.SUNNCITY.COM FOR MANY FREE THINGS,
INCLUDING JAVA ARCADE GAMES, ONLINE NEWS }
{ NEXT VERSION
MULTI-THREADED CASCADE UPDATE & DELETE (NO WAITING FOR DETAILS TO CATCH UP)
IF YOU SEE ANY FLAW OR UNSUITABLE CODE, PLEASE EMAIL ME
ACCEPT ANY COMMENTS AND IMPROVEMENT ARE DEEPLY WELCOME
}
unit Cascade;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, DB, DBIsamTB;
type
TCascadeType = (ctUpdateAndDelete,ctUpdate,ctDelete,ctReference);
TOnCascadeFail = Procedure (TableName:String;ErrorCode:Integer) of Object;
TCascade = class(TComponent)
private
FRefMessage:String;
FNormalBeforeEdit:TDataSetNotifyEvent;
FNormalBeforeDelete:TDataSetNotifyEvent;
FNormalBeforePost:TDataSetNotifyEvent;
FNormalOnPostError:TDataSetErrorEvent;
FNormalAfterPost:TDataSetNotifyEvent;
FNormalAfterDelete:TDataSetNotifyEvent;
FDBIsamDatabase:TDBIsamDatabase;
FSubDataSet: TDBIsamTable;
FMainDataSet: TDBIsamTable;
FShadowSet:TDBIsamTable;
FOnCascadeFail:TOnCascadeFail;
FLinkField: String;
FCascadeType: TCascadeType;
procedure SetMainDataSet(const Value: TDBIsamTable);
procedure SetSubDataSet(const Value: TDBIsamTable);
procedure SetLinkField(const Value: String);
protected
Failed:Boolean;
EditMode:Boolean;
ByPass:Boolean;
BeforeKey:String;
AfterKey:String;
Procedure FindMatchingField;
Procedure KeepKey(DataSet:TDataSet);
Procedure CascadeUpdate(DataSet:TDataSet);
Procedure CascadeDelete(DataSet:TDataSet);
Procedure CheckReference(DataSet:TDataSet);
procedure CheckAllow(DataSet: TDataSet);
Procedure CheckMasterError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
public
Procedure Loaded;Override;
Destructor Destroy;Override;
procedure Notification(AComponent: TComponent; Operation: TOperation); Override;
Constructor Create(AOwner:TComponent);Override;
Procedure Update;
published
Property CascadeType:TCascadeType read FCascadeType write FCascadeType;
Property LinkField:String read FLinkField write SetLinkField;
Property MainDataSet:TDBIsamTable read FMainDataSet write SetMainDataSet;
Property SubDataSet:TDBIsamTable read FSubDataSet write SetSubDataSet;
Property OnCascadeFail:TOnCascadeFail read FOnCascadeFail write FOnCascadeFail;
Property Database:TDBIsamDatabase read FDBIsamDatabase write FDBIsamDatabase;
Property RefMessage:String read FRefMessage Write FRefMessage;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Amazing2', [TCascade]);
end;
{ TCascade }
procedure TCascade.Update;
begin
CascadeUpdate(FMainDataSet);
end;
procedure TCascade.CascadeUpdate(DataSet: TDataSet);
begin
If Assigned(FNormalAfterPost) then FNormalAfterPost(Dataset);
AfterKey := FMainDataSet.FieldByName(FLinkfield).Value;
If (BeforeKey AfterKey) and (EditMode) then
Begin
if (FCascadetype = ctUpdateAndDelete) or
(FCascadetype = ctUpdate) then
Begin
While FShadowSet.Locate(FLinkField,BeforeKey,[]) do
Begin
FShadowSet.Edit;
Case FShadowSet.FieldByName(FLinkField).DataType of
ftInteger:FShadowSet.FieldByName(FLinkField).AsInteger := StrToInt(AfterKey);
ftString:FShadowSet.FieldByName(FLinkField).AsString := AfterKey;
End;
FShadowSet.Post;
End;
End;
FDBIsamDatabase.Commit;
FSubDataSet.Refresh;
If Not(FDBIsamDatabase.InTransaction) then FDBIsamDatabase.StartTransaction;
End
else
FDBIsamDatabase.Commmit;
end;
destructor TCascade.Destroy;
begin
If Assigned(FNormalBeforeEdit) then
FMainDataSet.BeforeEdit := FNormalBeforeEdit;
If Assigned(FNormalAfterPost) then
FMainDataSet.AfterPost := FNormalAfterPost;
If Assigned(FNormalOnPostError) then
FMainDataSet.OnPostError := FNormalOnPostError;
If Assigned(FNormalBeforeDelete) then
FMainDataSet.BeforeDelete := FNormalBeforeDelete;
If Assigned(FNormalBeforePost) then
FMainDataSet.BeforePost := FNormalBeforePost;
inherited Destroy;
end;
procedure TCascade.KeepKey(DataSet: TDataSet);
begin
If Not(FDBIsamDatabase.InTransaction) then FDBIsamDatabase.StartTransaction;
EditMode := True;
If Assigned(FNormalBeforeEdit) then FNormalBeforeEdit(DataSet);
BeforeKey := DataSet.FieldByName(FLinkField).Value;
end;
procedure TCascade.CheckAllow(DataSet: TDataSet);
begin
BeforeKey := DataSet.FieldByName(FLinkField).Value;
If Assigned(FNormalBeforeDelete) then FNormalBeforeDelete(DataSet);
If (FCascadeType = ctReference) then
Begin
If FSubDataSet.RecordCount 0 then
Raise Exception.Create(fRefMessage);
End;
end;
procedure TCascade.Loaded;
begin
inherited Loaded;
If Not(CsDesigning in ComponentState) then
Begin
FNormalBeforeEdit := FMainDataSet.BeforeEdit;
FNormalOnPostError := FMainDataSet.OnPostError;
FNormalAfterPost := FMainDataSet.AfterPost;
FNormalBeforeDelete := FMainDataSet.BeforeDelete;
FNormalBeforePost := FMainDataset.BeforePost;
FMainDataSet.BeforeEdit := KeepKey;
FMainDataSet.BeforeDelete := CheckAllow;
FMainDataSet.BeforePost := CheckReference;
FMainDataSet.AfterPost := CascadeUpdate;
FMainDataSet.AfterDelete := CascadeDelete;
FMainDataSet.OnPostError := CheckMasterError;
FShadowSet := TDBIsamTable.Create(Self);
FShadowSet.DatabaseName := FSubDataSet.DatabaseName;
FShadowSet.TableName := FSubDataSet.TableName;
FShadowSet.Active := True;
End;
end;
procedure TCascade.SetLinkField(const Value: String);
begin
FLinkField := Value;
end;
procedure TCascade.SetMainDataSet(const Value: TDBIsamTable);
begin
FMainDataSet := Value;
FindMatchingField;
end;
procedure TCascade.SetSubDataSet(const Value: TDBIsamTable);
begin
FSubDataSet := Value;
FindMatchingField;
end;
procedure TCascade.CheckMasterError(DataSet: TDataSet; E: EDatabaseError;
var Action: TDataAction);
begin
FDBIsamDatabase.RollBack;
If Not(FDBIsamDatabase.InTransaction) then FDBIsamDatabase.StartTransaction;
If Assigned(FOnCascadeFail) then FOnCasCadeFail(FMainDataSet.TableName,
EDBIsamEngineError(E).Errors[0].ErrorCode);
Abort;
end;
procedure TCascade.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
If Operation = OpRemove then
Begin
If AComponent = FMainDataSet then FMainDataSet := Nil;
If AComponent = FSubDataSet then FSubDataSet := Nil;
If AComponent = FDBIsamDatabase then FDBIsamDatabase := Nil;
End;
end;
procedure TCascade.CascadeDelete(DataSet: TDataSet);
Var V:Variant;
begin
If Assigned(FNormalAfterDelete) then FNormalAfterDelete(Dataset);
If (FCascadeType = ctUpdateAndDelete) or (FCascadeType = ctDelete) then
Begin
V := BeforeKey;
While FShadowSet.Locate(LinkField,V,[]) do FShadowSet.Delete;
FSubDataSet.Refresh;
End;
end;
procedure TCascade.FindMatchingField;
Var I,I2:Integer;
begin
If (FMainDataSet Nil) and (FSubDataSet Nil) and (Trim(FLinkField) = '') then
Begin
For I := 0 to FMainDataset.Fields.Count-1 do
Begin
For I2 := 0 to FSubDataSet.Fields.Count-1 do
Begin
If FMainDataSet.Fields[I].FieldName = FSubDataSet.Fields[I2].FieldName then
FLinkField := FMainDataSet.Fields[I].FieldName;
End;
End;
End;
end;
constructor TCascade.Create(AOwner: TComponent);
begin
inherited;
FRefMessage := 'Has details can not change value or delete';
end;
procedure TCascade.CheckReference(DataSet: TDataSet);
begin
If Assigned(FNormalBeforePost) then FNormalBeforePost(DataSet);
If (FCascadeType = ctReference) then
Begin
If BeforeKey DataSet.FieldByName(FLinkField).Value then
Begin
Raise Exception.Create(FRefMessage);
End;
End;
end;
end.