ucontactsync.pas

FMA is a free1 powerful phone editing tool allowing users to easily manage all of the personal data

      if Contact = Left then
        Result := slRight
      else
        Result := slLeft;
      Log.AddSynchronizationMessageFmt(_('Conflict has been solved in favor of %s'), [Contact.LinkedContact.ContactSource.Name], lsDebug);
    end;
    else begin
      Result := slNeither;
      Log.AddSynchronizationMessage(_('Conflict has not been solved'), lsDebug);
    end;
  end;
end;

procedure TSynchronizeContacts.Load;
var XMLContactSync: IXMLFmaSyncType;
    XMLContact: IXMLContactType;
    I: Integer;
    FMAContact: TContact;
    ExternContact: TContact;
begin
  Log.AddSynchronizationMessage(_('Loading started'), lsDebug);
  try
    if FileExists(FFileName) then begin
      XMLContactSync := Loadfmasync(FFileName);
      for I := 0 to XMLContactSync.Count - 1 do begin
        XMLContact := XMLContactSync.Contact[I];

        FMAContact := FMA.New;
        FMAContact.SyncID := XMLContact.SyncID;
        FMAContact.ID := XMLContact.FMA.ID;
        FMAContact.SyncHash := StrToInt(XMLContact.FMA.Hash);
        FMA.Contacts.Add(FMAContact);

        ExternContact := Extern.New;
        ExternContact.SyncID := XMLContact.SyncID;
        ExternContact.ID := XMLContact.Extern.ID;
        ExternContact.SyncHash := StrToInt(XMLContact.Extern.Hash);
        Extern.Contacts.Add(ExternContact);

        FMAContact.LinkedContact := ExternContact;
        ExternContact.LinkedContact := FMAContact;

        Application.ProcessMessages;
      end;
      Log.AddSynchronizationMessageFmt(_('Loaded %d contacts from XML'), [XMLContactSync.Count], lsDebug);
    end
    else
      if not DoFirstTime then Abort;

    FMA.Load;
    Extern.Load;

    Log.AddSynchronizationMessage(_('Loading completed'), lsDebug);
  except
    on E: ESynchronize do begin
      Log.AddSynchronizationMessageFmt(_('Loading error: %s'), [E.Message], lsError);
      DoError(E.Message);
    end;
  end;
end;

procedure TSynchronizeContacts.Save;
var XMLContactSync: IXMLFmaSyncType;
    XMLContact: IXMLContactType;
    I: Integer;
    FMAContact: TContact;
    ExternContact: TContact;
    ID: Integer;
begin
  Log.AddSynchronizationMessage(_('Saving started'), lsDebug);
  try
    XMLContactSync := Newfmasync;

    ID := 0;

    for I := 0 to FMA.Contacts.Count - 1 do begin
      FMAContact := FMA.Contacts[I];
      ExternContact := FMAContact.LinkedContact;

      if Assigned(ExternContact) and (not FMAContact.IsDeleted) and (not ExternContact.IsDeleted) then begin
        XMLContact := XMLContactSync.Add;
        XMLContact.SyncID := ID;

        XMLContact.FMA.ID := FMAContact.ID;
        XMLContact.FMA.Hash := '$' + IntToHex(FMAContact.Hash, 8);

        XMLContact.Extern.ID := ExternContact.ID;
        XMLContact.Extern.Hash := '$' + IntToHex(ExternContact.Hash, 8);

        Inc(ID);
      end;

      Application.ProcessMessages;
    end;

    XMLContactSync.OwnerDocument.SaveToFile(FFileName);

    Log.AddSynchronizationMessage(_('Saving completed'), lsDebug);
  except
    on E: ESynchronize do begin
      Log.AddSynchronizationMessageFmt(_('Saving error: %s'), [E.Message], lsError);
      DoError(E.Message);
    end;
  end;
end;

procedure TSynchronizeContacts.DoConflict(Contact,OtherContact: TContact; const Description:
    WideString; const Item0Name, Item1Name: String; var SelectedItem: Integer);
begin
  SelectedItem := 0;

  if Assigned(FOnConflict) then
    FOnConflict(Self, Contact, OtherContact, Description, Item0Name, Item1Name, SelectedItem);
  {
  if SelectedItem = -1 then
    SelectedItem := 0;
  }
end;

function TSynchronizeContacts.DoFirstTime: Boolean;
begin
  Result := True;
  
  if Assigned(FOnFirstTime) then
    FOnFirstTime(Self, Result);
end;

procedure TSynchronizeContacts.DoError(const Message: String);
begin
  if Assigned(FOnError) then
    FOnError(Self, Message);
end;

function TSynchronizeContacts.BuildCompareDescription(Contact, OtherContact: TContact): WideString;
{
var
  FullName: WideString;
begin
  if Contact.FullName <> '' then
    FullName := Contact.FullName
  else
    FullName := OtherContact.FullName;
}
begin
  case Contact.GetContactState of
    csUnchanged:
      Result := WideFormat(_('is unchanged in %s'), [Contact.ContactSource.Name]);
    csNew:
      Result := WideFormat(_('is new in %s'), [Contact.ContactSource.Name]);
    csChanged:
      Result := WideFormat(_('is changed in %s'), [Contact.ContactSource.Name]);
    csDeleted:
      Result := WideFormat(_('is deleted from %s'), [Contact.ContactSource.Name]);
    else
      Result := '';
  end;

  case OtherContact.GetContactState of
    csUnchanged:
      Result := Result + WideFormat(_(' and unchanged in %s'), [OtherContact.ContactSource.Name]);
    csNew:
      Result := Result + WideFormat(_(' and new in %s'), [OtherContact.ContactSource.Name]);
    csChanged:
      Result := Result + WideFormat(_(' and changed in %s'), [OtherContact.ContactSource.Name]);
    csDeleted:
      Result := Result + WideFormat(_(' and deleted from %s'), [OtherContact.ContactSource.Name]);
  end;
end;

function TSynchronizeContacts.BuildActionDescription(Action: TContactAction;
    Source: TContactSource; Contact: TContact): WideString;
begin
  case Action of
    caAdd:
      Result := WideFormat(_('%s will be added to %s'), [Contact.FullName, Source.Name]);
    caUpdate:
      Result := WideFormat(_('%s will be updated into %s'), [Contact.FullName, Source.Name]);
    caDelete:
      Result := WideFormat(_('%s will be deleted from %s'), [Contact.FullName, Source.Name]);
    else
      Result := '';
  end;
end;

function TSynchronizeContacts.Confirm(Action: TContactAction; Source: TContactSource; Contact: TContact): Boolean;
var Description: WideString;
begin
  Log.AddSynchronizationMessageFmt(_('Confirmation is asked for %s'), [Contact.FullName], lsDebug);

  Description := BuildActionDescription(Action, Source, Contact);

  DoConfirm(Contact, Action, Description, Result);

  if Result then
    Log.AddSynchronizationMessage(_('Confirmation is granted'), lsDebug)
  else
    Log.AddSynchronizationMessage(_('Confirmation is not granted'), lsDebug);
end;

procedure TSynchronizeContacts.DoConfirm(Contact: TContact; Action: 
    TContactAction; const Description: WideString; var Confirmed: Boolean);
begin
  Confirmed := True;
  if Assigned(FOnConfirm) then
    FOnConfirm(Self, Contact, Action, Description, Confirmed);
end;

function TSynchronizeContacts.Add(Source: TContactSource; Value: TContact): TContact;
begin
  Result := nil;

  if caAdd in Source.ConfirmActions then
    if not Confirm(caAdd, Source, Value) then Exit;

  Result := Source.Add(Value);

  Result.Synchronized := True;
  Value.Synchronized := True;
  Log.AddSynchronizationMessageFmt(_('%s is added to %s'), [Result.FullName, Source.Name], lsInformation);
end;

procedure TSynchronizeContacts.Update(Source: TContactSource; Contact, Value: TContact);
begin
  if caUpdate in Source.ConfirmActions then
    if not Confirm(caUpdate, Source, Value) then Exit;

  Source.Update(Contact, Value);

  Contact.Synchronized := True;
  Value.Synchronized := True;
  Log.AddSynchronizationMessageFmt(_('%s is updated into %s'), [Contact.FullName, Source.Name], lsInformation);
end;

procedure TSynchronizeContacts.Delete(Source: TContactSource; Contact, OtherContact: TContact);
begin
  if caDelete in Source.ConfirmActions then
    if not Confirm(caDelete, Source, Contact) then Exit;

  Source.Delete(Contact);

  Contact.Synchronized := True;
  OtherContact.Synchronized := True;
  Log.AddSynchronizationMessageFmt(_('%s is deleted from %s'), [Contact.FullName, Source.Name], lsInformation);
end;

procedure TSynchronizeContacts.Link(Contact, OtherContact: TContact);
begin
  Contact.LinkedContact := OtherContact;
  OtherContact.LinkedContact := Contact;

  Log.AddSynchronizationMessageFmt(_('%0:s in %1:s is linked to %2:s in %3:s'),
    [Contact.FullName, Contact.ContactSource.Name, OtherContact.FullName, OtherContact.ContactSource.Name], lsInformation);
end;

function TSynchronizeContacts.FindLink(Contact: TContact; OtherSource: TContactSource): TContact;
var I: Integer;
    OtherContact: TContact;
    OtherState: TContactState;
    PossibleLinks: TPossibleLinks;
    Score: Integer;
begin
  PossibleLinks := TPossibleLinks.Create;
  try
    for I := 0 to OtherSource.Contacts.Count - 1 do begin
      OtherContact := OtherSource.Contacts[I];
      if Assigned(OtherContact) then begin
        OtherState := OtherContact.GetContactState;

        if OtherState = csNew then begin
          Score := CalculateLinkScore(Contact, OtherContact);
          PossibleLinks.Add(OtherContact, Score)
        end;
      end;
    end;
    PossibleLinks.Sort;

    OtherContact := nil;
    if PossibleLinks.Count > 0 then
      DoChooseLink(Contact, PossibleLinks, OtherContact);
    Result := OtherContact;
  finally
    PossibleLinks.Free;
  end;
end;

function TSynchronizeContacts.CalculateLinkScore(Contact, OtherContact: TContact): Integer;
begin
  Result := 0;
  
  if Contact.Title = OtherContact.Title then
    Inc(Result, 1);
  if Contact.Name = OtherContact.Name then
    Inc(Result, 10);
  if Contact.SurName = OtherContact.SurName then
    Inc(Result, 100);
  if Contact.Organization = OtherContact.Organization then
    Inc(Result, 1);
  if Contact.Email = OtherContact.Email then
    Inc(Result, 100);
  if Contact.HomePhone = OtherContact.HomePhone then
    Inc(Result, 100);
  if Contact.WorkPhone = OtherContact.WorkPhone then
    Inc(Result, 10);
  if Contact.CellPhone = OtherContact.CellPhone then
    Inc(Result, 100);
  if Contact.FaxPhone = OtherContact.FaxPhone then
    Inc(Result, 10);
  if Contact.OtherPhone = OtherContact.OtherPhone then
    Inc(Result, 10);
  if Contact.Street = OtherContact.Street then
    Inc(Result, 10);
  if Contact.City = OtherContact.City then
    Inc(Result, 10);
  if Contact.Region = OtherContact.Region then
    Inc(Result, 1);
  if Contact.PostalCode = OtherContact.PostalCode then
    Inc(Result, 10);
  if Contact.Country = OtherContact.Country then
    Inc(Result, 1);

  if Contact.Birthday = OtherContact.Birthday then
    Inc(Result, 100);

  if Contact.Name = OtherContact.SurName then
    Inc(Result, 100);
  if Contact.SurName = OtherContact.Name then
    Inc(Result, 100);
end;

procedure TSynchronizeContacts.DoChooseLink(Contact: TContact; PossibleLinks: TPossibleLinks; var OtherContact: TContact);
begin
  if Assigned(FOnChooseLink) then
    FOnChooseLink(Self, Contact, PossibleLinks, OtherContact);
end;

procedure TSynchronizeContacts.Unlink(CDID: TGUID);
var XMLContactSync: IXMLFmaSyncType;
    XMLContact: IXMLContactType;
    I: Integer;
    Confirmed: Boolean;
begin
  Log.AddSynchronizationMessage(_('Unlinking started'), lsDebug);
  try
    if FileExists(FFileName) then begin
      XMLContactSync := Loadfmasync(FFileName);
      for I := 0 to XMLContactSync.Count - 1 do begin
        XMLContact := XMLContactSync.Contact[I];

        if IsEqualGUID(StringToGUID(XMLContact.FMA.ID), CDID) then begin
          Confirmed := False;
          DoConfirm(nil, caUnlink, _('Link found. About to unlinking'), Confirmed);

          if Confirmed then begin
            Log.AddSynchronizationMessageFmt(_('Link %s found and Unlinked'), [GUIDToString(CDID)], lsDebug);
            XMLContactSync.Delete(I);
          end;

          Break;
        end;

        Application.ProcessMessages;
      end;

      XMLContactSync.OwnerDocument.SaveToFile(FFileName);
    end;

    Log.AddSynchronizationMessage(_('Unlinking completed'), lsDebug);
  except
    on E: ESynchronize do begin
      Log.AddSynchronizationMessageFmt(_('Unlinking error: %s'), [E.Message], lsError);
      DoError(E.Message);
    end;
  end;
end;

{ TContact }

procedure TContact.Clone(Value: TContact);
begin
  inherited;

  Title := Value.Title;
  Name := Value.Name;
  SurName := Value.SurName;
  Organization := Value.Organization;
  Email := Value.Email;
  HomePhone := Value.HomePhone;
  WorkPhone := Value.WorkPhone;
  CellPhone := Value.CellPhone;
  FaxPhone := Value.FaxPhone;
  OtherPhone := Value.OtherPhone;
  Street := Value.Street;
  City := Value.City;
  Region := Value.Region;
  PostalCode := Value.PostalCode;
  Country := Value.Country;

  Birthday := Value.Birthday;

  SyncID := Value.SyncID;
  ID := Unassigned;
  SyncHash := Hash;
end;

constructor TContact.Create(ContactSource: TContactSource);
begin
  inherited Create;

  FContactSource := ContactSource;

  FSyncID := MaxCardinal;
end;

function TContact.GetContactState: TContactState;
begin
  if IsDeleted then
    Result := csDeleted
  else if IsNew then
    Result := csNew
  else if IsChanged then
    Result := csChanged
  else
    Result := csUnchanged;
end;

function TContact.GetHash: Cardinal;
var Str: String;
begin
  Str := GetHashString;
  Result := CalculateCRC32(Str[1], Length(Str));
end;

function TContact.GetHashString: String;
begin
  Result := FTitle + '|' + FCellPhone + '|' + FFaxPhone + '|' + FOtherPhone + '|' +
            FOrganization + '|' + FEmail + '|' + FName + '|' + FWorkPhone + '|' +
            FSurName + '|' +FHomePhone + '|' + FStreet + '|' + FCity + '|' +
            FRegion + '|' + FPostalCode + '|' + FCountry + '|' + DateToStr(FBirthday);
end;

function TContact.IsChanged: Boolean;
begin
  Result := FSyncHash <> Hash;
end;

function TContact.IsDeleted: Boolean;
begin
  Result := not Exists;
end;

function TContact.IsNew: Boolean;
begin
  Result := VarIsEmpty(FID) or not Assigned(FLinkedContact);
end;

function TContact.IsUnchanged: Boolean;
begin
  Result := not (IsNew or IsChanged or IsDeleted);
end;