Ignore:
Timestamp:
Jun 6, 2023, 11:15:57 AM (18 months ago)
Author:
chronos
Message:
  • Added: New file compare dialog with additional normalize options.
  • Modified: Compare action uses external compare tool.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/FormCompare.pas

    r149 r151  
    44
    55uses
    6   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
    7   VCard, Diff, LCLType, LCLIntf, ComCtrls, Buttons, Menus, ActnList, SynEdit,
    8   SynEditMiscClasses, SynHighlighterPosition, SynEditHighlighter, Common,
    9   USynEditEx;
     6  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, DataFile,
     7  VCardFile, VCard, Common, RegistryEx;
    108
    119type
    … …  
    1412
    1513  TFormCompare = class(TForm)
    16     ASwitchSides: TAction;
    17     AReloadFiles: TAction;
    18     AFileOpenLeft: TAction;
    19     AFileOpenRight: TAction;
    20     ActionList1: TActionList;
    21     EditLeftFileName: TEdit;
    22     EditRightFileName: TEdit;
    23     MainMenu1: TMainMenu;
    24     MenuItem1: TMenuItem;
    25     MenuItem2: TMenuItem;
    26     MenuItem3: TMenuItem;
    27     MenuItem4: TMenuItem;
    28     MenuItem5: TMenuItem;
    29     MenuItemClose: TMenuItem;
    30     OpenDialogSide: TOpenDialog;
    31     PanelLeft: TPanel;
    32     PanelRight: TPanel;
    33     SpeedButtonOpenLeft: TSpeedButton;
    34     SpeedButtonOpenRight: TSpeedButton;
    35     Splitter1: TSplitter;
    36     SynEditLeft: TSynEditEx;
    37     SynEditRight: TSynEditEx;
    38     procedure AFileOpenLeftExecute(Sender: TObject);
    39     procedure AFileOpenRightExecute(Sender: TObject);
    40     procedure AReloadFilesExecute(Sender: TObject);
    41     procedure ASwitchSidesExecute(Sender: TObject);
    42     procedure FormActivate(Sender: TObject);
     14    ButtonCancel: TButton;
     15    ButtonCompare: TButton;
     16    ButtonBrowse: TButton;
     17    CheckBoxWithoutPhotos: TCheckBox;
     18    CheckBoxSortContacts: TCheckBox;
     19    CheckBoxNormalizePhoneNumbers: TCheckBox;
     20    CheckBoxRemoveExactDuplicates: TCheckBox;
     21    EditAnotherFile: TEdit;
     22    Label1: TLabel;
     23    OpenDialog1: TOpenDialog;
     24    procedure ButtonBrowseClick(Sender: TObject);
     25    procedure ButtonCompareClick(Sender: TObject);
    4326    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    4427    procedure FormCreate(Sender: TObject);
    4528    procedure FormDestroy(Sender: TObject);
    46     procedure FormResize(Sender: TObject);
    4729    procedure FormShow(Sender: TObject);
    48     procedure MenuItemCloseClick(Sender: TObject);
    49     procedure SynEditLeftChange(Sender: TObject);
    50     procedure SynEditLeftScroll(Sender: TObject);
    51     procedure SynEditRightChange(Sender: TObject);
    52     procedure SynEditRightScroll(Sender: TObject);
    5330  private
    54     FLeftSide: string;
    55     FRightSide: string;
    56     Diff: TDiff;
    57     HighlighterLeft: TSynPositionHighlighter;
    58     HighlighterRight: TSynPositionHighlighter;
    59     AttrAdded: TtkTokenKind;
    60     AttrDeleted: TtkTokenKind;
    61     AttrModified: TtkTokenKind;
    62     LastWidth: Integer;
    63     procedure SetLeftSide(AValue: string);
    64     procedure SetRightSide(AValue: string);
    65     procedure ReloadContent;
    66     procedure UpdateInterface;
    67     procedure UpdateHighlight;
    68     function LoadFile(AFileName: string): string;
    69   public
    70     procedure LoadFileLeft(FileName: string);
    71     procedure LoadFileRight(FileName: string);
    72     property LeftSide: string read FLeftSide write SetLeftSide;
    73     property RightSide: string read FRightSide write SetRightSide;
     31    LeftVCard: TVCardFile;
     32    RightVCard: TVCardFile;
     33    procedure CompareInternal;
     34    procedure CompareExternal;
     35    procedure LoadConfig;
     36    procedure RemoveExactDuplicates(Contacts: TContacts);
     37    procedure NormalizePhoneNumbers(Contacts: TContacts);
     38    procedure RemovePhotos(Contacts: TContacts);
     39    procedure SaveConfig;
    7440  end;
    7541
    … …  
    8046
    8147uses
    82   Core, VCardFile;
     48  Core, FormCompareSideBySide;
    8349
    8450{ TFormCompare }
     51
     52procedure TFormCompare.FormCreate(Sender: TObject);
     53begin
     54  Core.Core.Translator.TranslateComponentRecursive(Self);
     55  Core.Core.ThemeManager1.UseTheme(Self);
     56  LeftVCard := TVCardFile.Create(nil);
     57  RightVCard := TVCardFile.Create(nil);
     58end;
     59
     60procedure TFormCompare.FormDestroy(Sender: TObject);
     61begin
     62  FreeAndNil(LeftVCard);
     63  FreeAndNil(RightVCard);
     64end;
    8565
    8666procedure TFormCompare.FormClose(Sender: TObject; var CloseAction: TCloseAction
    8767  );
    8868begin
     69  SaveConfig;
    8970  Core.Core.PersistentForm1.Save(Self);
    9071end;
    9172
    92 procedure TFormCompare.ASwitchSidesExecute(Sender: TObject);
     73procedure TFormCompare.ButtonCompareClick(Sender: TObject);
     74begin
     75  LeftVCard.Assign(TVCardFile(Core.Core.DataFile));
     76  RightVCard.LoadFromFile(EditAnotherFile.Text);
     77
     78  if CheckBoxSortContacts.Checked then begin
     79    LeftVCard.VCard.Contacts.Sort;
     80    RightVCard.VCard.Contacts.Sort;
     81  end;
     82
     83  if CheckBoxWithoutPhotos.Checked then begin
     84    RemovePhotos(LeftVCard.VCard.Contacts);
     85    RemovePhotos(RightVCard.VCard.Contacts);
     86  end;
     87
     88  if CheckBoxNormalizePhoneNumbers.Checked then begin
     89    NormalizePhoneNumbers(LeftVCard.VCard.Contacts);
     90    NormalizePhoneNumbers(RightVCard.VCard.Contacts);
     91  end;
     92
     93  if CheckBoxRemoveExactDuplicates.Checked then begin
     94    RemoveExactDuplicates(LeftVCard.VCard.Contacts);
     95    RemoveExactDuplicates(RightVCard.VCard.Contacts);
     96  end;
     97
     98  CompareExternal;
     99end;
     100
     101procedure TFormCompare.RemovePhotos(Contacts: TContacts);
     102var
     103  I: Integer;
     104  J: Integer;
     105  ContactProperties: TContactProperties;
     106begin
     107  for I := 0 to Contacts.Count - 1 do
     108  with Contacts[I].Properties do begin
     109    ContactProperties := GetMultipleByName('PHOTO');
     110    for J := ContactProperties.Count - 1 downto 0 do
     111      Remove(ContactProperties[J]);
     112    ContactProperties.Free;
     113  end;
     114end;
     115
     116procedure TFormCompare.NormalizePhoneNumbers(Contacts: TContacts);
     117var
     118  I: Integer;
     119  J: Integer;
     120  ContactProperties: TContactProperties;
     121begin
     122  for I := 0 to Contacts.Count - 1 do
     123  with Contacts[I].Properties do begin
     124    ContactProperties := GetMultipleByName('TEL');
     125    for J := 0 to ContactProperties.Count - 1 do begin
     126      ContactProperties[J].Value := StringReplace(ContactProperties[J].Value, ' ', '', [rfReplaceAll]);
     127      if not ContactProperties[J].Value.StartsWith('+') then
     128        ContactProperties[J].Value := Core.Core.DefaultPhoneCountryPrefix + ContactProperties[J].Value;
     129    end;
     130    ContactProperties.Free;
     131  end;
     132end;
     133
     134procedure TFormCompare.ButtonBrowseClick(Sender: TObject);
     135var
     136  TempFile: TDataFile;
     137begin
     138  TempFile := Core.Core.DefaultDataFileClass.Create(nil);
     139  try
     140    OpenDialog1.Filter := TempFile.GetFileFilter;
     141  finally
     142    TempFile.Free;
     143  end;
     144
     145  OpenDialog1.DefaultExt := '';
     146  OpenDialog1.InitialDir := ExtractFileDir(EditAnotherFile.Text);
     147  OpenDialog1.FileName := ExtractFileName(EditAnotherFile.Text);
     148  OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
     149  if OpenDialog1.Execute then begin
     150    EditAnotherFile.Text := OpenDialog1.FileName;
     151  end;
     152end;
     153
     154procedure TFormCompare.FormShow(Sender: TObject);
     155begin
     156  Core.Core.PersistentForm1.Load(Self);
     157  LoadConfig;
     158end;
     159
     160procedure TFormCompare.CompareInternal;
    93161var
    94162  TempFileName: string;
    95   TempContent: string;
    96 begin
    97   TempContent := SynEditLeft.Text;
    98   SynEditLeft.Text := SynEditRight.Text;
    99   SynEditRight.Text := TempContent;
    100 
    101   TempFileName := EditLeftFileName.Text;
    102   EditLeftFileName.Text := EditRightFileName.Text;
    103   EditRightFileName.Text := TempFileName;
    104 
    105   UpdateInterface;
    106   UpdateHighlight;
    107 end;
    108 
    109 procedure TFormCompare.FormActivate(Sender: TObject);
    110 begin
    111   if LastWidth = -1 then LastWidth := Width;
    112 end;
    113 
    114 procedure TFormCompare.AReloadFilesExecute(Sender: TObject);
    115 begin
    116   LoadFileLeft(EditLeftFileName.Text);
    117   LoadFileRight(EditRightFileName.Text);
    118   UpdateHighlight;
    119   UpdateInterface;
    120 end;
    121 
    122 procedure TFormCompare.AFileOpenLeftExecute(Sender: TObject);
    123 begin
    124   OpenDialogSide.InitialDir := ExtractFileDir(EditLeftFileName.Text);
    125   OpenDialogSide.FileName := ExtractFileName(EditLeftFileName.Text);
    126   if OpenDialogSide.Execute then begin
    127     EditLeftFileName.Text := OpenDialogSide.FileName;
    128     SynEditLeft.Text := LoadFileToStr(OpenDialogSide.FileName);
    129   end;
    130 end;
    131 
    132 procedure TFormCompare.AFileOpenRightExecute(Sender: TObject);
    133 begin
    134   OpenDialogSide.InitialDir := ExtractFileDir(EditRightFileName.Text);
    135   OpenDialogSide.FileName := ExtractFileName(EditRightFileName.Text);
    136   if OpenDialogSide.Execute then begin
    137     EditRightFileName.Text := OpenDialogSide.FileName;
    138     SynEditRight.Text := LoadFileToStr(OpenDialogSide.FileName);
    139   end;
    140   UpdateHighlight;
    141 end;
    142 
    143 procedure TFormCompare.FormCreate(Sender: TObject);
    144 begin
    145   Core.Core.Translator.TranslateComponentRecursive(Self);
    146   Core.Core.ThemeManager1.UseTheme(Self);
    147   Diff := TDiff.Create(Self);
    148 
    149   HighlighterLeft := TSynPositionHighlighter.Create(Self);
    150   with HighlighterLeft do begin
    151     AttrAdded := CreateTokenID('Added', clNone, clLightGreen, []);
    152     AttrDeleted := CreateTokenID('Deleted', clNone, clLightBlue, []);
    153     AttrModified := CreateTokenID('Modified', clNone, clLightRed, []);
    154   end;
    155   SynEditLeft.Highlighter := HighlighterLeft;
    156 
    157   HighlighterRight := TSynPositionHighlighter.Create(Self);
    158   with HighlighterRight do begin
    159     AttrAdded := CreateTokenID('Added', clNone, clLightGreen, []);
    160     AttrDeleted := CreateTokenID('Deleted', clNone, clLightBlue, []);
    161     AttrModified := CreateTokenID('Modified', clNone, clLightRed, []);
    162   end;
    163   SynEditRight.Highlighter := HighlighterRight;
    164 
    165   LastWidth := -1;
    166 end;
    167 
    168 procedure TFormCompare.FormDestroy(Sender: TObject);
    169 begin
    170   FreeAndNil(HighlighterLeft);
    171   FreeAndNil(HighlighterRight);
    172   FreeAndNil(Diff);
    173 end;
    174 
    175 procedure TFormCompare.FormResize(Sender: TObject);
    176 var
    177   LastHandler: TNotifyEvent;
    178   NewPanelWidth: Integer;
    179 const
    180   MaxRatio = 0.8;
    181 begin
    182   if LastWidth <> -1 then begin
    183     LastHandler := PanelLeft.OnResize;
    184     try
    185       PanelLeft.OnResize := nil;
    186       NewPanelWidth := Round((PanelLeft.Width / LastWidth) * Width);
    187       if NewPanelWidth > Round(Width * MaxRatio) then NewPanelWidth := Round(Width * MaxRatio);
    188       PanelLeft.Width := NewPanelWidth;
    189     finally
    190       PanelLeft.OnResize := LastHandler;
    191     end;
    192     LastWidth := Width;
    193   end;
    194 end;
    195 
    196 procedure TFormCompare.FormShow(Sender: TObject);
    197 begin
    198   Core.Core.PersistentForm1.Load(Self);
    199   UpdateInterface;
    200   ReloadContent;
    201 end;
    202 
    203 procedure TFormCompare.MenuItemCloseClick(Sender: TObject);
    204 begin
    205   Close;
    206 end;
    207 
    208 procedure TFormCompare.SynEditLeftChange(Sender: TObject);
    209 begin
    210   UpdateHighlight;
    211 end;
    212 
    213 procedure TFormCompare.SynEditLeftScroll(Sender: TObject);
    214 begin
    215   SynEditRight.TopLine := SynEditLeft.TopLine;
    216 end;
    217 
    218 procedure TFormCompare.SynEditRightChange(Sender: TObject);
    219 begin
    220   UpdateHighlight;
    221 end;
    222 
    223 procedure TFormCompare.SynEditRightScroll(Sender: TObject);
    224 begin
    225   SynEditLeft.TopLine := SynEditRight.TopLine;
    226 end;
    227 
    228 procedure TFormCompare.SetLeftSide(AValue: string);
    229 begin
    230   if FLeftSide = AValue then Exit;
    231   FLeftSide := AValue;
    232 end;
    233 
    234 procedure TFormCompare.SetRightSide(AValue: string);
    235 begin
    236   if FRightSide = AValue then Exit;
    237   FRightSide := AValue;
    238 end;
    239 
    240 procedure TFormCompare.ReloadContent;
    241 begin
    242   UpdateHighlight;
    243 end;
    244 
    245 procedure TFormCompare.UpdateInterface;
    246 begin
    247 end;
    248 
    249 procedure TFormCompare.UpdateHighlight;
    250 var
    251   LeftText: string;
    252   RightText: string;
     163begin
     164  with TFormCompareSideBySide.Create(nil) do
     165  try
     166    TempFileName := Core.Core.GetTempDir +
     167      DirectorySeparator + 'Compare' + VCardFileExt;
     168    ForceDirectories(ExtractFileDir(TempFileName));
     169    TVCardFile(Core.Core.DataFile).SaveToFile(TempFileName);
     170    LoadFileLeft(TempFileName);
     171    LoadFileRight(EditAnotherFile.Text);
     172    ShowModal;
     173  finally
     174    Free;
     175  end;
     176end;
     177
     178procedure CompareText(TextLeft, TextRight: string; FileNameLeft: string = 'FileLeft.txt';
     179  FileNameRight: string = 'FileRight.txt');
     180var
     181  TempFileRight: string;
     182  TempFileLeft: string;
     183begin
     184  if not DirectoryExists(Core.Core.GetTempDir) then
     185    CreateDir(Core.Core.GetTempDir);
     186  TempFileLeft := Core.Core.GetTempDir + DirectorySeparator + FileNameLeft;
     187  TempFileRight := Core.Core.GetTempDir + DirectorySeparator + FileNameRight;
     188  SaveStringToFile(TextLeft, TempFileLeft);
     189  SaveStringToFile(TextRight, TempFileRight);
     190  ExecuteProgram(Core.Core.CompareTool, [TempFileLeft, TempFileRight]);
     191end;
     192
     193procedure TFormCompare.CompareExternal;
     194begin
     195  CompareText(LeftVCard.VCard.AsString, RightVCard.Vcard.AsString,
     196    ExtractFileName(LeftVCard.FileName), ExtractFileName(EditAnotherFile.Text));
     197end;
     198
     199procedure TFormCompare.LoadConfig;
     200begin
     201  with TRegistryEx.Create do
     202  try
     203    CurrentContext := Core.Core.ApplicationInfo1.GetRegistryContext;
     204    EditAnotherFile.Text := ReadStringWithDefault('LastCompareFileName', '');
     205    CheckBoxWithoutPhotos.Checked := ReadBoolWithDefault('WithoutPhotos', True);
     206    CheckBoxSortContacts.Checked := ReadBoolWithDefault('SortContacts', True);
     207    CheckBoxNormalizePhoneNumbers.Checked := ReadBoolWithDefault('NormalizePhoneNumbers', True);
     208    CheckBoxRemoveExactDuplicates.Checked := ReadBoolWithDefault('RemoveExactDuplicates', True);
     209  finally
     210    Free;
     211  end;
     212end;
     213
     214procedure TFormCompare.RemoveExactDuplicates(Contacts: TContacts);
     215var
    253216  I: Integer;
    254   LastKind: TChangeKind;
    255   P1: TPoint;
    256   P2: TPoint;
    257   Rec: TCompareRec;
    258   NextToken1: TtkTokenKind;
    259   NextToken2: TtkTokenKind;
    260 begin
    261   LeftText := SynEditLeft.Lines.Text;
    262   RightText := SynEditRight.Lines.Text;
    263 
    264   Diff.Execute(PChar(LeftText), PChar(RightText), Length(LeftText), Length(RightText));
    265 
    266   HighlighterLeft.ClearAllTokens;
    267   HighlighterRight.ClearAllTokens;
    268   LeftText := '';
    269   RightText := '';
    270   LastKind := ckNone;
    271   P1 := Point(1, 0);
    272   P2 := Point(1, 0);
    273   NextToken1 := tkText;
    274   NextToken2 := tkText;
    275   for I := 0 to Diff.Count - 1 do
    276     with Diff.Compares[I] do begin
    277       Rec := Diff.Compares[I];
    278       if Rec.Chr1 = LineEnding then begin
    279         if NextToken1 <> tkText then begin
    280           HighlighterLeft.AddToken(P1.Y, 0, NextToken1);
    281           NextToken1 := tkText;
    282         end;
    283         Inc(P1.Y);
    284         P1.X := 0;
    285         LeftText := LeftText + Rec.Chr1;
    286       end else begin
    287         if Kind = ckAdd then LeftText := LeftText + ' '
    288           else LeftText := LeftText + Rec.chr1;
    289         if Kind <> LastKind then begin
    290           HighlighterLeft.AddToken(P1.Y, P1.X, NextToken1);
    291           if Kind = ckNone then NextToken1 := tkText
    292           //else if Kind = ckAdd then NextToken1 := AttrAdded
    293           else if Kind = ckDelete then NextToken1 := AttrDeleted
    294           else if Kind = ckModify then NextToken1 := AttrModified;
    295         end;
    296         Inc(P1.X);
    297       end;
    298 
    299       if Rec.Chr2 = LineEnding then begin
    300         if NextToken2 <> tkText then begin
    301           HighlighterRight.AddToken(P2.Y, 0, NextToken2);
    302           NextToken2 := tkText;
    303         end;
    304         Inc(P2.Y);
    305         P2.X := 0;
    306         RightText := RightText + Rec.Chr2;
    307       end else begin
    308         if Kind = ckDelete then RightText := RightText + ' '
    309           else RightText := RightText + Rec.Chr2;
    310         if Kind <> LastKind then begin
    311           HighlighterRight.AddToken(P2.Y, P2.X, NextToken2);
    312           if Kind = ckNone then NextToken2 := tkText
    313           else if Kind = ckAdd then NextToken2 := AttrAdded
    314           //else if Kind = ckDelete then NextToken2 := AttrDeleted
    315           else if Kind = ckModify then NextToken2 := AttrModified;
    316         end;
    317         Inc(P2.X);
    318       end;
    319 
    320       LastKind := Kind;
    321     end;
    322 
    323   //SynEditLeft.Lines.Text := LeftText;
    324   //SynEditRight.Lines.Text := RightText;
    325 end;
    326 
    327 function TFormCompare.LoadFile(AFileName: string): string;
    328 var
    329   Ext: string;
    330 begin
    331   Ext := ExtractFileExt(AFileName);
    332   if Ext = VCardFileExt then begin
    333     with TVCardFile.Create(nil) do
    334     try
    335       LoadFromFile(AFileName);
    336       Result := VCard.AsString;
    337     finally
    338       Free;
    339     end;
    340   end else Result := LoadFileToStr(AFileName);
    341 end;
    342 
    343 procedure TFormCompare.LoadFileLeft(FileName: string);
    344 begin
    345   EditLeftFileName.Text := FileName;
    346   LeftSide := LoadFile(FileName);
    347   SynEditLeft.Text := LeftSide;
    348 end;
    349 
    350 procedure TFormCompare.LoadFileRight(FileName: string);
    351 begin
    352   EditRightFileName.Text := FileName;
    353   RightSide := LoadFile(FileName);
    354   SynEditRight.Text := RightSide;
     217begin
     218  Contacts.RemoveExactDuplicates;
     219  for I := 0 to Contacts.Count - 1 do
     220    Contacts[I].Properties.RemoveExactDuplicates;
     221end;
     222
     223procedure TFormCompare.SaveConfig;
     224begin
     225  with TRegistryEx.Create do
     226  try
     227    CurrentContext := Core.Core.ApplicationInfo1.GetRegistryContext;
     228    WriteString('LastCompareFileName', EditAnotherFile.Text);
     229    WriteBool('WithoutPhotos', CheckBoxWithoutPhotos.Checked);
     230    WriteBool('SortContacts', CheckBoxSortContacts.Checked);
     231    WriteBool('NormalizePhoneNumbers', CheckBoxNormalizePhoneNumbers.Checked);
     232    WriteBool('RemoveExactDuplicates', CheckBoxRemoveExactDuplicates.Checked);
     233  finally
     234    Free;
     235  end;
    355236end;
    356237
Note: See TracChangeset for help on using the changeset viewer.