?? ucontactsync.pas
字號:
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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -