Recent

Author Topic: Adding Delta functionality similar to TClientDataSet to Lazarus TDataSet  (Read 2869 times)

bpranoto

  • Full Member
  • ***
  • Posts: 155
Error:
Code: Pascal  [Select][+][-]
  1. unit1.pas(77,12) Error: identifier idents no member "Changed"
  2. unit1.pas(77,30) Error: identifier idents no member "Changed"

Fix:

Code: Pascal  [Select][+][-]
  1. diff --git a/DataSetDelta.pas b/DataSetDelta.pas
  2. index 9687258..9f4aa82 100644
  3. --- a/DataSetDelta.pas
  4. +++ b/DataSetDelta.pas
  5. @@ -26,6 +26,8 @@ type
  6.    TDataStateValue = (dsvOriginal, dsvDeleted, dsvInserted, dsvUpdated);
  7.    TDataStateValues=set of TDataStateValue;
  8.  
  9. +  { TDataSetChangesMonitor }
  10. +
  11.    TDataSetChangesMonitor =class(TComponent)
  12.    private
  13.      FDataState:TDataStateValue;
  14. @@ -49,6 +51,7 @@ type
  15.      destructor Destroy; override;
  16.      function GetActionSQL(const ATableName : String; const AKeyFields: String = ''): String;
  17.      procedure ActivateMonitoring(AValue:Boolean =true);
  18. +    function Changed:Boolean;
  19.      property ChangedCount:int64 read GetChangedCount;
  20.      property DataSet:TDataSet read FDataSet write SetDataSet;
  21.    end;
  22. @@ -227,6 +230,11 @@ begin
  23.    end;
  24.  end;
  25.  
  26. +function TDataSetChangesMonitor.Changed: Boolean;
  27. +begin
  28. +  Result:=Self.GetChangedCount>0;
  29. +end;
  30. +
  31.  function TDataSetChangesMonitor.GetActionSQL(const ATableName
  32.    : String; const AKeyFields: String = ''): String;
  33.  var
  34.  

szlbz

  • New Member
  • *
  • Posts: 39
Error:
Code: Pascal  [Select][+][-]
  1. unit1.pas(77,12) Error: identifier idents no member "Changed"
  2. unit1.pas(77,30) Error: identifier idents no member "Changed"

Fix:

Code: Pascal  [Select][+][-]
  1. diff --git a/DataSetDelta.pas b/DataSetDelta.pas
  2. index 9687258..9f4aa82 100644
  3. --- a/DataSetDelta.pas
  4. +++ b/DataSetDelta.pas
  5. @@ -26,6 +26,8 @@ type
  6.    TDataStateValue = (dsvOriginal, dsvDeleted, dsvInserted, dsvUpdated);
  7.    TDataStateValues=set of TDataStateValue;
  8.  
  9. +  { TDataSetChangesMonitor }
  10. +
  11.    TDataSetChangesMonitor =class(TComponent)
  12.    private
  13.      FDataState:TDataStateValue;
  14. @@ -49,6 +51,7 @@ type
  15.      destructor Destroy; override;
  16.      function GetActionSQL(const ATableName : String; const AKeyFields: String = ''): String;
  17.      procedure ActivateMonitoring(AValue:Boolean =true);
  18. +    function Changed:Boolean;
  19.      property ChangedCount:int64 read GetChangedCount;
  20.      property DataSet:TDataSet read FDataSet write SetDataSet;
  21.    end;
  22. @@ -227,6 +230,11 @@ begin
  23.    end;
  24.  end;
  25.  
  26. +function TDataSetChangesMonitor.Changed: Boolean;
  27. +begin
  28. +  Result:=Self.GetChangedCount>0;
  29. +end;
  30. +
  31.  function TDataSetChangesMonitor.GetActionSQL(const ATableName
  32.    : String; const AKeyFields: String = ''): String;
  33.  var
  34.  
github update fail,已重新上传

szlbz

  • New Member
  • *
  • Posts: 39
Code: Pascal  [Select][+][-]
  1. {*******************************************************}
  2. {                                                       }
  3. { 为lazarus TDataSet增加类似TClientDataSet的Delta功能   }
  4. {                    适用于所有TDataSet                 }
  5. {                                                       }
  6. {                                                       }
  7. {               Copyright(c) 2024-2024                  }
  8. {              秋风(QQ315795176)原创出品                }
  9. {                                                       }
  10. {                 All rights reserved                   }
  11. {                     保留所有权利                      }
  12. {                                                       }
  13. {*******************************************************}
  14.  
  15. unit DataSetDelta;
  16.  
  17. {$mode objfpc}{$H+}
  18.  
  19. interface
  20.  
  21. uses
  22.   Classes, SysUtils, BufDataset, DB, TypInfo, Variants;
  23.  
  24. type
  25.  
  26.   TDataStateValue = (dsvOriginal, dsvDeleted, dsvInserted, dsvUpdated);
  27.   TDataStateValues=set of TDataStateValue;
  28.  
  29.   TDataSetChangesMonitor =class(TComponent)
  30.   private
  31.     FDataState:TDataStateValue;
  32.     Foldvalue:array of Variant;
  33.     FBeforeEdit: TDataSetNotifyEvent;
  34.     FBeforeDelete: TDataSetNotifyEvent;
  35.     FBeforeInsert: TDataSetNotifyEvent;
  36.     FAfterPost: TDataSetNotifyEvent;
  37.     FNewDataSet:TBufDataSet;
  38.     FOldDataSet:TBufDataSet;
  39.     FDataSet:TDataSet;
  40.     procedure CreateMonitorDataSet;
  41.     procedure SetDataSet(AValue: TDataSet);
  42.     procedure BeforeInserts(DataSet: TDataSet);
  43.     procedure BeforeEdits(DataSet: TDataSet);
  44.     procedure BeforeDeletes(DataSet:TDataSet);
  45.     procedure AfterPosts(DataSet: TDataSet);
  46.     function GetChanged:Boolean;
  47.   public
  48.     constructor Create(AOwner: TComponent); override;
  49.     destructor Destroy; override;
  50.     function GetActionSQL(const ATableName : String; const AKeyFields: String = ''): String;
  51.     procedure ActivateMonitoring(AValue:Boolean =true);
  52.     property Changed:Boolean read GetChanged;
  53.     property DataSet:TDataSet read FDataSet write SetDataSet;
  54.   end;
  55.  
  56. implementation
  57.  
  58. constructor TDataSetChangesMonitor.Create(AOwner: TComponent);
  59. begin
  60.   inherited Create(AOwner);
  61. end;
  62.  
  63. destructor TDataSetChangesMonitor.Destroy;
  64. begin
  65.   inherited Destroy;
  66.   FBeforeEdit:=nil;
  67.   FBeforeDelete:=nil;
  68.   FBeforeInsert:=nil;
  69.   FAfterPost:=nil;
  70.   Foldvalue:=nil;
  71.   if Assigned(FNewDataSet) then
  72.     freeandnil(FNewDataSet);
  73.   if Assigned(FOldDataSet) then
  74.     freeandnil(FOldDataSet);
  75. end;
  76.  
  77. function TDataSetChangesMonitor.GetChanged:Boolean;
  78. begin
  79.   Result:=FOldDataSet.RecordCount>0;
  80. end;
  81.  
  82. procedure TDataSetChangesMonitor.SetDataSet(AValue: TDataSet);
  83. begin
  84.   if (AValue <> FDataSet) then
  85.   begin
  86.     FDataSet:=AValue;
  87.     if not (csDesigning in ComponentState) then
  88.       CreateMonitorDataSet;
  89.   end;
  90. end;
  91.  
  92. procedure TDataSetChangesMonitor.CreateMonitorDataSet;
  93. var
  94.   i:integer;
  95.   LFieldName, LFieldType: string;
  96.   LFieldSize : Integer;
  97. begin
  98.   if Foldvalue<>nil then Foldvalue:=nil;
  99.   setlength(Foldvalue,FDataSet.Fields.Count);
  100.  
  101.   if Assigned(FNewDataSet) then freeandnil(FNewDataSet);
  102.   if Assigned(FOldDataSet) then freeandnil(FOldDataSet);
  103.  
  104.   FNewDataSet:=TBufDataSet.Create(nil);
  105.   for I := 0 to FDataSet.FieldCount - 1 do
  106.   begin
  107.     LFieldName := FDataSet.Fields[I].FieldName;
  108.     LFieldType := GetEnumName(TypeInfo(TFieldType), Integer(FDataSet.Fields[I].DataType));
  109.     LFieldSize := FDataSet.Fields[I].DataSize;
  110.     if (LFieldType = 'ftString') then
  111.       FNewDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)), LFieldSize)
  112.     else
  113.       FNewDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)));
  114.   end;
  115.   FNewDataSet.FieldDefs.Add('DataState', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftinteger')));
  116.   FNewDataSet.CreateDataset;
  117.  
  118.   FOldDataSet:=TBufDataSet.Create(nil);
  119.   for I := 0 to FDataSet.FieldCount - 1 do
  120.   begin
  121.     LFieldName := FDataSet.Fields[I].FieldName;
  122.     LFieldType := GetEnumName(TypeInfo(TFieldType), Integer(FDataSet.Fields[I].DataType));
  123.     LFieldSize := FDataSet.Fields[I].DataSize;
  124.     if (LFieldType = 'ftString')  then
  125.       FOldDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)), LFieldSize)
  126.     else
  127.       FOldDataSet.FieldDefs.Add(LFieldName, TFieldType(GetEnumValue(TypeInfo(TFieldType), LFieldType)));
  128.   end;
  129.   FOldDataSet.FieldDefs.Add('DataState', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftinteger')));
  130.   FOldDataSet.CreateDataset;
  131. end;
  132.  
  133. procedure TDataSetChangesMonitor.BeforeInserts(DataSet: TDataSet);
  134. var
  135.   i:integer;
  136. begin
  137.   if Foldvalue<>nil then
  138.   begin
  139.     FDataState:=dsvInserted;
  140.     for i:=0 to DataSet.Fields.Count-1 do
  141.       Foldvalue[i]:=null;
  142.   end;
  143. end;
  144.  
  145. procedure TDataSetChangesMonitor.BeforeEdits(DataSet: TDataSet);
  146. var
  147.   i:integer;
  148. begin
  149.   if Foldvalue<>nil then
  150.   begin
  151.     FDataState:=dsvUpdated;
  152.     for i:=0 to DataSet.Fields.Count-1 do
  153.       Foldvalue[i]:=DataSet.Fields[i].NewValue;
  154.   end;
  155. end;
  156.  
  157. procedure TDataSetChangesMonitor.BeforeDeletes(DataSet: TDataSet);
  158. var
  159.   i:integer;
  160. begin
  161.   FDataState:=dsvDeleted;
  162.   if Foldvalue<>nil then
  163.   begin
  164.     FNewDataSet.Append;
  165.     FOldDataSet.Append;
  166.     for i:=0 to DataSet.Fields.Count-1 do
  167.     begin
  168.       FNewDataSet.Fields[i].Value := DataSet.Fields[i].NewValue;
  169.       FOldDataSet.Fields[i].Value := null;
  170.     end;
  171.     FOldDataSet.FieldByName('DataState').Asinteger:=ord(FDataState);
  172.     FOldDataSet.Post;
  173.     FNewDataSet.Post;
  174.   end;
  175. end;
  176.  
  177. procedure TDataSetChangesMonitor.AfterPosts(DataSet: TDataSet);
  178. var
  179.   i:integer;
  180.   s:string;
  181. begin
  182.   if Foldvalue<>nil then
  183.   begin
  184.     FNewDataSet.Append;
  185.     FOldDataSet.Append;
  186.     for i:=0 to DataSet.Fields.Count-1 do
  187.     begin
  188.       FNewDataSet.Fields[i].Value := DataSet.Fields[i].NewValue;
  189.       FOldDataSet.Fields[i].Value := Foldvalue[i];
  190.       FOldDataSet.FieldByName('DataState').Asinteger:=ord(FDataState);
  191.     end;
  192.     FNewDataSet.Post;
  193.     FOldDataSet.Post;
  194.   end;
  195. end;
  196.  
  197. procedure TDataSetChangesMonitor.ActivateMonitoring(AValue:Boolean =true);
  198. begin
  199.   if AValue then
  200.   begin
  201.     if not (csDesigning in ComponentState) then
  202.     begin
  203.       FBeforeEdit:=FDataSet.BeforeEdit;
  204.       FBeforeDelete:=FDataSet.BeforeDelete;
  205.       FBeforeInsert:=FDataSet.BeforeInsert;
  206.       FAfterPost:=FDataSet.AfterPost;
  207.       FDataSet.BeforeEdit:=@BeforeEdits;
  208.       FDataSet.BeforeDelete:=@BeforeDeletes;
  209.       FDataSet.BeforeInsert:=@BeforeInserts;
  210.       FDataSet.AfterPost:=@AfterPosts;
  211.       CreateMonitorDataSet;
  212.     end;
  213.   end
  214.   else
  215.   begin
  216.     FBeforeEdit:=nil;
  217.     FBeforeDelete:=nil;
  218.     FBeforeInsert:=nil;
  219.     FAfterPost:=nil;
  220.     Foldvalue:=nil;
  221.     if Assigned(FNewDataSet) then
  222.       freeandnil(FNewDataSet);
  223.     if Assigned(FOldDataSet) then
  224.       freeandnil(FOldDataSet);
  225.   end;
  226. end;
  227.  
  228. function TDataSetChangesMonitor.GetActionSQL(const ATableName
  229.   : String; const AKeyFields: String = ''): String;
  230. var
  231.   nFldOrder: integer;
  232.   cFldName, s1, s2: String;
  233.  
  234.   function SQLValue(const ADataSet: TBufDataSet; AOrder: Integer): String;
  235.   var
  236.     cValue: String;
  237.     eType: TFieldType;
  238.   begin
  239.     eType := ADataSet.Fields[AOrder].DataType;
  240.     cValue := ADataSet.Fields[AOrder].Value;
  241.     if eType in [ftString, ftDate, ftTime, ftDateTime,
  242.       ftFixedChar, ftWideString] then
  243.     begin
  244.       Result := QuotedStr(cValue)
  245.     end
  246.     else
  247.     if eType in [ftBoolean] then
  248.     begin
  249.       if SameText(cValue, 'True') then
  250.           Result := '1'
  251.       else
  252.           Result := '0';
  253.     end
  254.     else
  255.         Result := cValue;
  256.   end;
  257.  
  258.   function MakeWhere(const ADataSet: TBufDataSet): String;
  259.   var
  260.     cKeyFields: String;
  261.     i: Integer;
  262.   begin
  263.     cKeyFields := AKeyFields + ',';
  264.     Result := '';
  265.     for i := 0 to ADataSet.FieldCount - 1 do
  266.     begin
  267.       cFldName := ADataSet.Fields[i].FieldName;
  268.       if (cFldName<>'DataState') then
  269.       begin
  270.         if (cKeyFields = ',') or (Pos(cFldName + ',', cKeyFields) > 0) then
  271.         begin
  272.           if Result <> '' then
  273.               Result := Result + ' AND ';
  274.           if ADataSet.Fields[i].IsNull then
  275.               Result := Result + cFldName + ' IS NULL'
  276.           else
  277.               Result := Result + cFldName + ' = ' + SQLValue(ADataSet, i);
  278.         end;
  279.       end;
  280.     end;
  281.   end;
  282. begin
  283.   Result := '';
  284.   if Assigned(FNewDataSet) then
  285.   begin
  286.     if (FNewDataSet.RecordCount>0) then
  287.     begin
  288.       FNewDataSet.First;
  289.       FOldDataSet.First;
  290.       while not FOldDataSet.EOF do
  291.       begin
  292.         //INSERTED
  293.         if FOldDataSet.FieldByName('DataState').Asinteger =ord(dsvINSERTED) then
  294.         begin
  295.           s1 := '';
  296.           s2 := '';
  297.           for nFldOrder := 0 to FNewDataSet.FieldCount - 1 do
  298.           begin
  299.             cFldName := FNewDataSet.Fields[nFldOrder].FieldName;
  300.             if (cFldName<>'DataState')  then
  301.             begin
  302.               if not FNewDataSet.Fields[nFldOrder].IsNull then
  303.               begin
  304.                 if s1 <> '' then
  305.                     s1 := s1 + ',';
  306.                 if s2 <> '' then
  307.                     s2 := s2 + ',';
  308.                 s1 := s1 + cFldName;
  309.                 s2 := s2 + SQLValue(FNewDataSet, nFldOrder);
  310.               end;
  311.             end;
  312.           end;
  313.           Result :=Result+ 'INSERT INTO ' + ATableName + ' (' + s1 + ')' +
  314.             ' VALUES (' + s2 + ')'+LineEnding;
  315.         end;
  316.         //Updated
  317.         if FOldDataSet.FieldByName('DataState').Asinteger=ord(dsvUpdated) then
  318.         begin
  319.           s2 := '';
  320.           for nFldOrder := 0 to FNewDataSet.FieldCount - 1 do
  321.           begin
  322.             cFldName := FNewDataSet.Fields[nFldOrder].FieldName;
  323.             if (cFldName<>'DataState') then
  324.             begin
  325.               if FOldDataSet.FieldByName(cFldName).AsVariant <> FNewDataSet.FieldByName(cFldName).AsVariant then
  326.               begin
  327.                 if s2 <> '' then
  328.                     s2 := s2 + ', ';
  329.                 if FNewDataSet.FieldByName(cFldName).IsNull then
  330.                     s2 := s2 + cFldName + ' = NULL'
  331.                 else
  332.                     s2 := s2 + cFldName + ' = ' + SQLValue(FNewDataSet, nFldOrder);
  333.               end;
  334.             end;
  335.           end;
  336.           Result :=Result+ 'UPDATE ' + ATableName + ' SET ' + s2 +
  337.             ' WHERE ' + MakeWhere(FOldDataSet)+LineEnding;
  338.         end;
  339.         //Deleted
  340.         if FOldDataSet.FieldByName('DataState').Asinteger=ord(dsvDeleted) then
  341.         begin
  342.           Result :=Result+ 'DELETE FROM ' + ATableName + ' WHERE ' + MakeWhere(FNewDataSet)+LineEnding;
  343.         end;
  344.  
  345.         FOldDataSet.Next;
  346.         FNewDataSet.Next;
  347.       end;
  348.       CreateMonitorDataSet;
  349.     end;
  350.   end;
  351. end;
  352.  
  353. initialization
  354.  
  355. finalization
  356.  
  357. end.
  358.  

Thaddy

  • Hero Member
  • *****
  • Posts: 14849
  • Censorship about opinions does not belong here.
It looks OK! compliments.
Will test it soon.
Still, you might consider what I suggested: Integrate it in TCustomDataSet.
Remember the Medway disaster..

szlbz

  • New Member
  • *
  • Posts: 39
It looks OK! compliments.
Will test it soon.
Still, you might consider what I suggested: Integrate it in TCustomDataSet.
Sorry, TCustomDataset not found

Thaddy

  • Hero Member
  • *****
  • Posts: 14849
  • Censorship about opinions does not belong here.
Yes, I see. That is different from Delphi. Implement it in TDataset....
[edit]
No, it isn't, I confused specializations of TDataset, which often have a custom implementation.
« Last Edit: June 07, 2024, 12:18:08 pm by Thaddy »
Remember the Medway disaster..

szlbz

  • New Member
  • *
  • Posts: 39
2024-06-08
将TDataSetChangesMonitor封装为控件,安装DatasetMonitorPack.lpk就可以。
Code: Pascal  [Select][+][-]
  1. procedure TForm1.FormCreate(Sender: TObject);
  2. begin
  3.  
  4.   BufDataset2.FieldDefs.Clear;
  5.   BufDataset2.FieldDefs.Add('vstr1', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftString')), 30);
  6.   BufDataset2.FieldDefs.Add('vint1', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftinteger')));
  7.   BufDataset2.FieldDefs.Add('vint2', TFieldType(GetEnumValue(TypeInfo(TFieldType), 'ftinteger')));
  8.   BufDataset2.CreateDataset;
  9.  
  10.   memo1.Lines.Clear;
  11.   BufDataset2.Open;
  12.  
  13.   dcm2:=TQFDataSetMonitor.Create(self);
  14.   dcm2.DataSet:=BufDataset2; //监控BufDataset2的数据变化
  15.   dcm2.ActivateMonitoring;
  16.  
  17.   {$ifdef linux}
  18.   SQLiteLibraryName:=ExtractFilePath(Application.ExeName)+'libsqlite3.so';
  19.   {$else}
  20.   SQLiteLibraryName:=utf8tocp936(ExtractFilePath(Application.ExeName)+'sqlite3.dll');
  21.   {$endif}
  22.   ZConnection1.Disconnect;
  23.   ZConnection1.Protocol:='sqlite';
  24.   ZConnection1.LibraryLocation:=utf8tocp936(ExtractFilePath(Application.ExeName)+{$ifdef linux}'libsqlite3.so'{$else}'sqlite3.dll'{$endif});
  25.   ZConnection1.Properties.Clear;
  26.   ZConnection1.Properties.Add('encrypted=yes');
  27.   ZConnection1.Properties.Add('cipher=sqlcipher');
  28.   ZConnection1.Properties.Add('sqlcipher=legacy');
  29.   ZConnection1.Properties.Add('legacy=1');
  30.   ZConnection1.Properties.Add('controls_cp=CP_UTF8');
  31.   ZConnection1.Properties.Add('AutoEncodeStrings=True');
  32.   ZConnection1.Database:='demo.db3';
  33.   ZConnection1.Password:='123asd';
  34.   ZConnection1.Connect;
  35.   ZQuery1.Close;
  36.   ZQuery1.SQL.Text:='select * from hardware';
  37.   ZQuery1.Open;
  38.   QFDataSetMonitor1.Active:=true;//激活监控功能
  39.  
  40. end;

szlbz

  • New Member
  • *
  • Posts: 39
截图二

szlbz

  • New Member
  • *
  • Posts: 39
今天修正了TQFDataSetMonitor.Active可能存在失效的Bug,需要的请重新下载。

 

TinyPortal © 2005-2018