{*******************************************************}
{ }
{ 为lazarus TDataSet增加类似TClientDataSet的Delta功能 }
{ 适用于所有TDataSet }
{ }
{ }
{ Copyright(c) 2024-2024 }
{ 秋风(QQ315795176)原创出品 }
{ }
{ All rights reserved }
{ 保留所有权利 }
{ }
{*******************************************************}
unit DataSetDelta;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, BufDataset, DB, TypInfo, Variants;
type
TDataStateValue = (dsvOriginal, dsvDeleted, dsvInserted, dsvUpdated);
TDataStateValues=set of TDataStateValue;
TDataSetChangesMonitor =class(TComponent)
private
FDataState:TDataStateValue;
Foldvalue:array of Variant;
FBeforeEdit: TDataSetNotifyEvent;
FBeforeDelete: TDataSetNotifyEvent;
FBeforeInsert: TDataSetNotifyEvent;
FAfterPost: TDataSetNotifyEvent;
FNewDataSet:TBufDataSet;
FOldDataSet:TBufDataSet;
FDataSet:TDataSet;
procedure Crea]"]>BlockednitorDataSet;
procedure SetDataSet(AValue: TDataSet);
procedure BeforeInserts(DataSet: TDataSet);
procedure BeforeEdits(DataSet: TDataSet);
procedure BeforeDeletes(DataSet:TDataSet);
procedure AfterPosts(DataSet: TDataSet);
function GetChanged:Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetActionSQL(const ATableName : String; const AKeyFields: String = ''): String;
procedure Activa]"]>Blockednitoring(AValue:Boolean =true);
property Changed:Boolean read GetChanged;
property DataSet:TDataSet read FDataSet write SetDataSet;
end;
implementation
constructor TDataSetChangesMonitor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TDataSetChangesMonitor.Destroy;
begin
inherited Destroy;
FBeforeEdit:=nil;
FBeforeDelete:=nil;
FBeforeInsert:=nil;
FAfterPost:=nil;
Foldvalue:=nil;
if Assigned(FNewDataSet) then
freeandnil(FNewDataSet);
if Assigned(FOldDataSet) then
freeandnil(FOldDataSet);
end;
function TDataSetChangesMonitor.GetChanged:Boolean;
begin
Result:=FOldDataSet.RecordCount>0;
end;
procedure TDataSetChangesMonitor.SetDataSet(AValue: TDataSet);
begin
if (AValue <> FDataSet) then
begin
FDataSet:=AValue;
if not (csDesigning in ComponentState) then
Crea]"]>BlockednitorDataSet;
end;
end;
procedure TDataSetChangesMonitor.Crea]"]>BlockednitorDataSet;
var
i:integer;
LFieldName, LFieldType: string;
LFieldSize : Integer;
begin
if Foldvalue<>nil then Foldvalue:=nil;
setlength(Foldvalue,FDataSet.Fields.Count);
if Assigned(FNewDataSet) then freeandnil(FNewDataSet);
if Assigned(FOldDataSet) then freeandnil(FOldDataSet);
FNewDataSet:=TBufDataSet.Create(nil);
for I := 0 to FDataSet.FieldCount - 1 do
begin
LFieldName := FDataSet.Fields[I].FieldName;
LFieldType := GetEnumName(TypeInfo(TFieldType), Integer(FDataSet.Fields[I].DataType));
LFieldSize := FDataSet.Fields[I].DataSize;
if (LFieldType = 'ftString') then
FNewDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)), LFieldSize)
else
FNewDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)));
end;
FNewDataSet.FieldDefs.Add('DataState', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftinteger')));
FNewDataSet.CreateDataset;
FOldDataSet:=TBufDataSet.Create(nil);
for I := 0 to FDataSet.FieldCount - 1 do
begin
LFieldName := FDataSet.Fields[I].FieldName;
LFieldType := GetEnumName(TypeInfo(TFieldType), Integer(FDataSet.Fields[I].DataType));
LFieldSize := FDataSet.Fields[I].DataSize;
if (LFieldType = 'ftString') then
FOldDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)), LFieldSize)
else
FOldDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)));
end;
FOldDataSet.FieldDefs.Add('DataState', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftinteger')));
FOldDataSet.CreateDataset;
end;
procedure TDataSetChangesMonitor.BeforeInserts(DataSet: TDataSet);
var
i:integer;
begin
if Foldvalue<>nil then
begin
FDataState:=dsvInserted;
for i:=0 to DataSet.Fields.Count-1 do
Foldvalue[i]:=null;
end;
end;
procedure TDataSetChangesMonitor.BeforeEdits(DataSet: TDataSet);
var
i:integer;
begin
if Foldvalue<>nil then
begin
FDataState:=dsvUpdated;
for i:=0 to DataSet.Fields.Count-1 do
Foldvalue[i]:=DataSet.Fields[i].NewValue;
end;
end;
procedure TDataSetChangesMonitor.BeforeDeletes(DataSet: TDataSet);
var
i:integer;
begin
FDataState:=dsvDeleted;
if Foldvalue<>nil then
begin
FNewDataSet.Append;
FOldDataSet.Append;
for i:=0 to DataSet.Fields.Count-1 do
begin
FNewDataSet.Fields[i].Value := DataSet.Fields[i].NewValue;
FOldDataSet.Fields[i].Value := null;
end;
FOldDataSet.FieldByName('DataState').Asinteger:=ord(FDataState);
FOldDataSet.Post;
FNewDataSet.Post;
end;
end;
procedure TDataSetChangesMonitor.AfterPosts(DataSet: TDataSet);
var
i:integer;
s:string;
begin
if Foldvalue<>nil then
begin
FNewDataSet.Append;
FOldDataSet.Append;
for i:=0 to DataSet.Fields.Count-1 do
begin
FNewDataSet.Fields[i].Value := DataSet.Fields[i].NewValue;
FOldDataSet.Fields[i].Value := Foldvalue[i];
FOldDataSet.FieldByName('DataState').Asinteger:=ord(FDataState);
end;
FNewDataSet.Post;
FOldDataSet.Post;
end;
end;
procedure TDataSetChangesMonitor.Activa]"]>Blockednitoring(AValue:Boolean =true);
begin
if AValue then
begin
if not (csDesigning in ComponentState) then
begin
FBeforeEdit:=FDataSet.BeforeEdit;
FBeforeDelete:=FDataSet.BeforeDelete;
FBeforeInsert:=FDataSet.BeforeInsert;
FAfterPost:=FDataSet.AfterPost;
FDataSet.BeforeEdit:=@BeforeEdits;
FDataSet.BeforeDelete:=@BeforeDeletes;
FDataSet.BeforeInsert:=@BeforeInserts;
FDataSet.AfterPost:=@AfterPosts;
Crea]"]>BlockednitorDataSet;
end;
end
else
begin
FBeforeEdit:=nil;
FBeforeDelete:=nil;
FBeforeInsert:=nil;
FAfterPost:=nil;
Foldvalue:=nil;
if Assigned(FNewDataSet) then
freeandnil(FNewDataSet);
if Assigned(FOldDataSet) then
freeandnil(FOldDataSet);
end;
end;
function TDataSetChangesMonitor.GetActionSQL(const ATableName
: String; const AKeyFields: String = ''): String;
var
nFldOrder: integer;
cFldName, s1, s2: String;
function SQLValue(const ADataSet: TBufDataSet; AOrder: Integer): String;
var
cValue: String;
eType: TFieldType;
begin
eType := ADataSet.Fields[AOrder].DataType;
cValue := ADataSet.Fields[AOrder].Value;
if eType in [ftString, ftDate, ftTime, ftDateTime,
ftFixedChar, ftWideString] then
begin
Result := QuotedStr(cValue)
end
else
if eType in [ftBoolean] then
begin
if SameText(cValue, 'True') then
Result := '1'
else
Result := '0';
end
else
Result := cValue;
end;
function MakeWhere(const ADataSet: TBufDataSet): String;
var
cKeyFields: String;
i: Integer;
begin
cKeyFields := AKeyFields + ',';
Result := '';
for i := 0 to ADataSet.FieldCount - 1 do
begin
cFldName := ADataSet.Fields[i].FieldName;
if (cFldName<>'DataState') then
begin
if (cKeyFields = ',') or (Pos(cFldName + ',', cKeyFields) > 0) then
begin
if Result <> '' then
Result := Result + ' AND ';
if ADataSet.Fields[i].IsNull then
Result := Result + cFldName + ' IS NULL'
else
Result := Result + cFldName + ' = ' + SQLValue(ADataSet, i);
end;
end;
end;
end;
begin
Result := '';
if Assigned(FNewDataSet) then
begin
if (FNewDataSet.RecordCount>0) then
begin
FNewDataSet.First;
FOldDataSet.First;
while not FOldDataSet.EOF do
begin
//INSERTED
if FOldDataSet.FieldByName('DataState').Asinteger =ord(dsvINSERTED) then
begin
s1 := '';
s2 := '';
for nFldOrder := 0 to FNewDataSet.FieldCount - 1 do
begin
cFldName := FNewDataSet.Fields[nFldOrder].FieldName;
if (cFldName<>'DataState') then
begin
if not FNewDataSet.Fields[nFldOrder].IsNull then
begin
if s1 <> '' then
s1 := s1 + ',';
if s2 <> '' then
s2 := s2 + ',';
s1 := s1 + cFldName;
s2 := s2 + SQLValue(FNewDataSet, nFldOrder);
end;
end;
end;
Result :=Result+ 'INSERT INTO ' + ATableName + ' (' + s1 + ')' +
' VALUES (' + s2 + ')'+LineEnding;
end;
//Updated
if FOldDataSet.FieldByName('DataState').Asinteger=ord(dsvUpdated) then
begin
s2 := '';
for nFldOrder := 0 to FNewDataSet.FieldCount - 1 do
begin
cFldName := FNewDataSet.Fields[nFldOrder].FieldName;
if (cFldName<>'DataState') then
begin
if FOldDataSet.FieldByName(cFldName).AsVariant <> FNewDataSet.FieldByName(cFldName).AsVariant then
begin
if s2 <> '' then
s2 := s2 + ', ';
if FNewDataSet.FieldByName(cFldName).IsNull then
s2 := s2 + cFldName + ' = NULL'
else
s2 := s2 + cFldName + ' = ' + SQLValue(FNewDataSet, nFldOrder);
end;
end;
end;
Result :=Result+ 'UPDATE ' + ATableName + ' SET ' + s2 +
' WHERE ' + MakeWhere(FOldDataSet)+LineEnding;
end;
//Deleted
if FOldDataSet.FieldByName('DataState').Asinteger=ord(dsvDeleted) then
begin
Result :=Result+ 'DELETE FROM ' + ATableName + ' WHERE ' + MakeWhere(FNewDataSet)+LineEnding;
end;
FOldDataSet.Next;
FNewDataSet.Next;
end;
Crea]"]>BlockednitorDataSet;
end;
end;
end;
initialization
finalization
end.
Recent
