Changeset 40 for trunk/UContact.pas


Ignore:
Timestamp:
Dec 1, 2021, 11:41:48 PM (3 years ago)
Author:
chronos
Message:
  • Fixed: Correctly load/save general, home and work fields.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UContact.pas

    r39 r40  
    1616
    1717  TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTitleBefore,
    18     cfTitleAfter, cfFullName, cfTelCell, cfTelHome, cfTelHome2, cfTelWork, cfTelVoip,
    19     cfTelMain, cfEmail, cfTel, cfUid, cfUrlHome, cfUrlWork,
    20     cfEmailHome, cfEmailInternet, cfNickName, cfNote, cfRole, cfTitle,
     18    cfTitleAfter, cfFullName,
     19    cfTel, cfTelCell, cfTelFax, cfTelPager, cfTelHome2, cfTelVoip, cfTelMain,
     20    cfTelHome, cfTelCellHome, cfTelFaxHome, cfTelPagerHome,
     21    cfTelWork, cfTelCellWork, cfTelFaxWork, cfTelPagerWork,
     22    cfEmail, cfUid, cfUrl, cfUrlHome, cfUrlWork,
     23    cfEmailHome, cfEmailWork, cfEmailInternet, cfNickName, cfNote, cfRole, cfTitle,
    2124    cfCategories, cfOrganization, cfDepartment,
    2225    cfHomeAddressStreet, cfHomeAddressStreetExtended, cfHomeAddressCity, cfHomeAddressCountry,
    … …  
    2528    cfWorkAddressPostalCode, cfWorkAddressRegion, cfWorkAddressPostOfficeBox,
    2629    cfXTimesContacted, cfXLastTimeContacted, cfPhoto, cfXJabber, cfDayOfBirth, cfRevision,
    27     cfVersion);
     30    cfVersion, cfAnniversary);
    2831
    2932  TContactField = class
    3033    SysName: string;
    3134    Groups: TStringArray;
     35    NoGroups: TStringArray;
    3236    Title: string;
    3337    Index: TContactFieldIndex;
    … …  
    3943
    4044  TContactFields = class(TFPGObjectList<TContactField>)
    41     function AddNew(Name: string; Groups: array of string; Title: string; Index: TContactFieldIndex; DataType:
     45    function AddNew(Name: string; Groups: array of string; NoGroups: array of string;
     46      Title: string; Index: TContactFieldIndex; DataType:
    4247      TDataType; ValueIndex: Integer = -1): TContactField;
    4348    function GetByIndex(Index: TContactFieldIndex): TContactField;
    … …  
    5560    procedure EvaluateAttributes;
    5661    function GetDecodedValue: string;
    57     function MatchNameGroups(AName: string; Groups: TStringArray): Boolean;
     62    function MatchNameGroups(AName: string; Groups: TStringArray;
     63      NoGroups: TStringArray): Boolean;
    5864    procedure Assign(Source: TContactProperty);
    5965    constructor Create;
    … …  
    6672    procedure AssignToList(List: TFPGObjectList<TObject>);
    6773    function GetByName(Name: string): TContactProperty;
    68     function GetByNameGroups(Name: string; Groups: TStringArray): TContactProperty;
    69     function GetByNameGroupsMultiple(Name: string; Groups: TStringArray): TContactProperties;
     74    function GetByNameGroups(Name: string; Groups: TStringArray;
     75      NoGroups: TStringArray): TContactProperty;
     76    function GetByNameGroupsMultiple(Name: string; Groups: TStringArray;
     77      NoGroups: TStringArray): TContactProperties;
    7078  end;
    7179
    … …  
    126134resourcestring
    127135  SVCardFile = 'vCard file';
    128   SUnsupportedContactFieldsIndex = 'Unsupported contact field index';
    129   SUnknownCommand = 'Unknown command: %s';
    130136  SFoundPropertiesBeforeBlockStart = 'Found properties before the start of block';
    131137  SFoundBlockEndWithoutBlockStart = 'Found block end without block start';
    … …  
    138144  SFullName = 'Full Name';
    139145  STelephone = 'Telephone';
    140   SCellPhone = 'Cell phone';
     146  SMobilePhone = 'Mobile phone';
     147  SPager = 'Pager';
     148  SFax = 'Fax';
    141149  SHomePhone = 'Home phone';
     150  SHomeMobile = 'Home mobile';
     151  SHomeFax = 'Home fax';
     152  SHomePager = 'Home pager';
     153  SWorkPhone = 'Work phone';
     154  SWorkFax = 'Work fax';
     155  SWorkPager = 'Work pager';
     156  SWorkMobile = 'Work mobile';
    142157  SHomePhone2 = 'Home phone 2';
    143   SWorkPhone = 'Work phone';
    144158  SVoipPhone = 'VoIP phone';
    145159  SMainPhone = 'Main phone';
    146160  SEmail = 'E-mail';
    147   SHomeEmail = 'Home Email';
    148   SInternetEmail = 'Internet Email';
    149   SNickName = 'Nick Name';
     161  SHomeEmail = 'Home E-mail';
     162  SWorkEmail = 'Work E-mail';
     163  SInternetEmail = 'Internet E-mail';
     164  SNickName = 'Nick name';
    150165  SNote = 'Note';
    151166  SRole = 'Role';
    … …  
    173188  SJabber = 'Jabber';
    174189  SDayOfBirth = 'Day of birth';
     190  SAnniversary = 'Anniversary';
    175191  SRevision = 'Revision';
    176192  SUniqueIdentifier = 'Unique identifier';
     193  SWebAddress = 'Web address';
    177194  SWebAddressHome = 'Web address home';
    178195  SWebAddressWork = 'Web address work';
    … …  
    223240end;
    224241
    225 function TContactProperties.GetByNameGroups(Name: string; Groups: TStringArray
    226   ): TContactProperty;
     242function TContactProperties.GetByNameGroups(Name: string; Groups: TStringArray;
     243  NoGroups: TStringArray): TContactProperty;
    227244var
    228245  I: Integer;
    229246begin
    230247  I := 0;
    231   while (I < Count) and not Items[I].MatchNameGroups(Name, Groups) do Inc(I);
     248  while (I < Count) and not Items[I].MatchNameGroups(Name, Groups, NoGroups) do Inc(I);
    232249  if I < Count then Result := Items[I]
    233250    else Result := nil;
    … …  
    235252
    236253function TContactProperties.GetByNameGroupsMultiple(Name: string;
    237   Groups: TStringArray): TContactProperties;
     254  Groups: TStringArray; NoGroups: TStringArray): TContactProperties;
    238255var
    239256  I: Integer;
    … …  
    241258  Result := TContactProperties.Create(False);
    242259  for I := 0 to Count - 1 do
    243   if Items[I].MatchNameGroups(Name, Groups) then
     260  if Items[I].MatchNameGroups(Name, Groups, NoGroups) then
    244261    Result.Add(Items[I]);
    245262end;
    … …  
    283300end;
    284301
    285 function TContactProperty.MatchNameGroups(AName: string; Groups: TStringArray
    286   ): Boolean;
    287 var
    288   I: Integer;
    289 begin
     302function TContactProperty.MatchNameGroups(AName: string; Groups: TStringArray;
     303  NoGroups: TStringArray): Boolean;
     304var
     305  I: Integer;
     306  Attr: string;
     307begin
     308  Attr := Attributes.DelimitedText;
    290309  Result := Name = AName;
    291   if Result then begin
     310  if Result and (Length(Groups) > 0) then begin
    292311    for I := 0 to Length(Groups) - 1 do
    293       if Attributes.IndexOf(Groups[I]) = -1 then begin
     312      if (Attributes.IndexOf(Groups[I]) = -1) and
     313      (Attributes.IndexOf('TYPE=' + Groups[I]) = -1) then begin
     314        Result := False;
     315        Break;
     316      end;
     317  end;
     318  if Result and (Length(NoGroups) > 0) then begin
     319    for I := 0 to Length(NoGroups) - 1 do
     320      if (Attributes.IndexOf(NoGroups[I]) <> -1) or
     321      (Attributes.IndexOf('TYPE=' + NoGroups[I]) <> -1) then begin
    294322        Result := False;
    295323        Break;
    … …  
    368396{ TContactFields }
    369397
    370 function TContactFields.AddNew(Name: string; Groups: array of string; Title: string; Index: TContactFieldIndex;
     398function TContactFields.AddNew(Name: string; Groups: array of string;
     399  NoGroups: array of string; Title: string; Index: TContactFieldIndex;
    371400  DataType: TDataType; ValueIndex: Integer = -1): TContactField;
    372401var
    … …  
    378407  for I := 0 to Length(Groups) - 1 do
    379408    Result.Groups[I] := Groups[I];
     409  SetLength(Result.NoGroups, Length(NoGroups));
     410  for I := 0 to Length(NoGroups) - 1 do
     411    Result.NoGroups[I] := NoGroups[I];
    380412  Result.Title := Title;
    381413  Result.Index := Index;
    … …  
    431463  Field := Parent.Fields.GetByIndex(Index);
    432464  if Assigned(Field) then begin
    433     Prop := Properties.GetByNameGroups(Field.SysName, Field.Groups);
    434     if not Assigned(Prop) then begin
     465    Prop := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
     466    if (not Assigned(Prop)) and (AValue <> '') then begin
    435467      Prop := TContactProperty.Create;
    436468      Prop.Name := Field.SysName;
    … …  
    439471      Properties.Add(Prop);
    440472    end;
    441     if Field.ValueIndex <> -1 then begin
    442       while Prop.Values.Count <= Field.ValueIndex do Prop.Values.Add('');
    443       Prop.Values.Strings[Field.ValueIndex] := AValue
    444     end else Prop.Values.DelimitedText := AValue;
     473    if Assigned(Prop) then begin
     474      if Field.ValueIndex <> -1 then begin
     475        // Extend subitems count
     476        while Prop.Values.Count <= Field.ValueIndex do
     477          Prop.Values.Add('');
     478
     479        Prop.Values.Strings[Field.ValueIndex] := AValue;
     480      end else Prop.Values.DelimitedText := AValue;
     481
     482      // Remove empty items
     483      while (Prop.Values.Count > 0) and (Prop.Values.Strings[Prop.Values.Count - 1] = '') do
     484        Prop.Values.Delete(Prop.Values.Count - 1);
     485
     486      // Remove if empty
     487      if Prop.Values.Text = '' then begin
     488        Properties.Remove(Prop);
     489      end;
     490    end;
    445491  end else raise Exception.Create(SFieldIndexNotDefined);
    446492end;
    … …  
    453499  Field := Parent.Fields.GetByIndex(Index);
    454500  if Assigned(Field) then begin
    455     Result := Properties.GetByNameGroups(Field.SysName, Field.Groups);
     501    Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
    456502  end else raise Exception.Create(SFieldIndexNotDefined);
    457503end;
    … …  
    501547begin
    502548  with Fields do begin
    503     AddNew('N', [], SLastName, cfLastName, dtString, 0);
    504     AddNew('N', [], SFirstName, cfFirstName, dtString, 1);
    505     AddNew('N', [], SMiddleName, cfMiddleName, dtString, 2);
    506     AddNew('N', [], STitleBefore, cfTitleBefore, dtString, 3);
    507     AddNew('N', [], STitleAfter, cfTitleAfter, dtString, 4);
    508     AddNew('FN', [], SFullName, cfFullName, dtString);
    509     AddNew('TEL', [], STelephone, cfTel, dtString);
    510     AddNew('TEL', ['CELL'], SCellPhone, cfTelCell, dtString);
    511     AddNew('TEL', ['HOME'], SHomePhone, cfTelHome, dtString);
    512     AddNew('TEL', ['HOME2'], SHomePhone2, cfTelHome2, dtString);
    513     AddNew('TEL', ['WORK'], SWorkPhone, cfTelWork, dtString);
    514     AddNew('TEL', ['VOIP'], SVoipPhone, cfTelVoip, dtString);
    515     AddNew('TEL', ['MAIN'], SMainPhone, cfTelMain, dtString);
    516     AddNew('EMAIL', [], SEmail, cfEmail, dtString);
    517     AddNew('EMAIL', ['HOME'], SHomeEmail, cfEmailHome, dtString);
    518     AddNew('EMAIL', ['INTERNET'], SInternetEmail, cfEmailInternet, dtString);
    519     AddNew('NICKNAME', [], SNickName, cfNickName, dtString);
    520     AddNew('NOTE', [], SNote, cfNote, dtString);
    521     AddNew('ROLE', [], SRole, cfRole, dtString);
    522     AddNew('TITLE', [], STitle, cfTitle, dtString);
    523     AddNew('CATEGORIES', [], SCategories, cfCategories, dtString);
    524     AddNew('ORG', [], SOrganization, cfOrganization, dtString, 0);
    525     AddNew('ORG', [], SDepartement, cfDepartment, dtString, 1);
    526     AddNew('ADR', ['HOME'], SHomeAddressPostOfficeBox, cfHomeAddressPostOfficeBox, dtString, 0);
    527     AddNew('ADR', ['HOME'], SHomeAddressStreetExtended, cfHomeAddressStreetExtended, dtString, 1);
    528     AddNew('ADR', ['HOME'], SHomeAddressStreet, cfHomeAddressStreet, dtString, 2);
    529     AddNew('ADR', ['HOME'], SHomeAddressCity, cfHomeAddressCity, dtString, 3);
    530     AddNew('ADR', ['HOME'], SHomeAddressRegion, cfHomeAddressRegion, dtString, 4);
    531     AddNew('ADR', ['HOME'], SHomeAddressPostalCode, cfHomeAddressPostalCode, dtString, 5);
    532     AddNew('ADR', ['HOME'], SHomeAddressCountry, cfHomeAddressCountry, dtString, 6);
    533     AddNew('ADR', ['WORK'], SWorkAddressPostOfficeBox, cfWorkAddressPostOfficeBox, dtString, 0);
    534     AddNew('ADR', ['WORK'], SWorkAddressStreetExtended, cfWorkAddressStreetExtended, dtString, 1);
    535     AddNew('ADR', ['WORK'], SWorkAddressStreet, cfWorkAddressStreet, dtString, 2);
    536     AddNew('ADR', ['WORK'], SWorkAddressCity, cfWorkAddressCity, dtString, 3);
    537     AddNew('ADR', ['WORK'], SWorkAddressRegion, cfWorkAddressRegion, dtString, 4);
    538     AddNew('ADR', ['WORK'], SWorkAddressPostalCode, cfWorkAddressPostalCode, dtString, 5);
    539     AddNew('ADR', ['WORK'], SWorkAddressCountry, cfWorkAddressCountry, dtString, 6);
    540     AddNew('X-TIMES_CONTACTED', [], STimesContacted, cfXTimesContacted, dtString);
    541     AddNew('X-LAST_TIME_CONTACTED', [], SLastTimeContacted, cfXLastTimeContacted, dtString);
    542     AddNew('PHOTO', [], SPhoto, cfPhoto, dtString);
    543     AddNew('X-JABBER', [], SJabber, cfXJabber, dtString);
    544     AddNew('BDAY', [], SDayOfBirth, cfDayOfBirth, dtString);
    545     AddNew('REV', [], SRevision, cfRevision, dtString);
    546     AddNew('UID', [], SUniqueIdentifier, cfUid, dtString);
    547     AddNew('URL', ['HOME'], SWebAddressHome, cfUrlHome, dtString);
    548     AddNew('URL', ['WORK'], SWebAddressWork, cfUrlWork, dtString);
     549    AddNew('N', [], [], SLastName, cfLastName, dtString, 0);
     550    AddNew('N', [], [], SFirstName, cfFirstName, dtString, 1);
     551    AddNew('N', [], [], SMiddleName, cfMiddleName, dtString, 2);
     552    AddNew('N', [], [], STitleBefore, cfTitleBefore, dtString, 3);
     553    AddNew('N', [], [], STitleAfter, cfTitleAfter, dtString, 4);
     554    AddNew('FN', [], [], SFullName, cfFullName, dtString);
     555    AddNew('TEL', [], ['CELL', 'FAX', 'PAGER', 'WORK', 'HOME'], STelephone, cfTel, dtString);
     556    AddNew('TEL', ['CELL'], ['WORK', 'HOME'], SMobilePhone, cfTelCell, dtString);
     557    AddNew('TEL', ['FAX'], ['WORK', 'HOME'], SFax, cfTelFax, dtString);
     558    AddNew('TEL', ['PAGER'], ['WORK', 'HOME'], SPager, cfTelPager, dtString);
     559    AddNew('TEL', ['HOME'], ['CELL', 'FAX', 'PAGER'], SHomePhone, cfTelHome, dtString);
     560    AddNew('TEL', ['HOME', 'CELL'], [], SHomeMobile, cfTelCellHome, dtString);
     561    AddNew('TEL', ['HOME', 'FAX'], [], SHomeFax, cfTelFaxHome, dtString);
     562    AddNew('TEL', ['HOME', 'PAGER'], [], SHomePager, cfTelPagerHome, dtString);
     563    AddNew('TEL', ['WORK'], ['CELL', 'FAX', 'PAGER'], SWorkPhone, cfTelWork, dtString);
     564    AddNew('TEL', ['WORK', 'CELL'], [], SWorkMobile, cfTelCellWork, dtString);
     565    AddNew('TEL', ['WORK', 'FAX'], [], SWorkFax, cfTelFaxWork, dtString);
     566    AddNew('TEL', ['WORK', 'PAGER'], [], SWorkPager, cfTelPagerWork, dtString);
     567    AddNew('TEL', ['HOME2'], [], SHomePhone2, cfTelHome2, dtString);
     568    AddNew('TEL', ['VOIP'], [], SVoipPhone, cfTelVoip, dtString);
     569    AddNew('TEL', ['MAIN'], [], SMainPhone, cfTelMain, dtString);
     570    AddNew('EMAIL', [], ['HOME', 'WORK', 'INTERNET'], SEmail, cfEmail, dtString);
     571    AddNew('EMAIL', ['HOME'], [], SHomeEmail, cfEmailHome, dtString);
     572    AddNew('EMAIL', ['WORK'], [], SWorkEmail, cfEmailWork, dtString);
     573    AddNew('EMAIL', ['INTERNET'], [], SInternetEmail, cfEmailInternet, dtString);
     574    AddNew('NICKNAME', [], [], SNickName, cfNickName, dtString);
     575    AddNew('NOTE', [], [], SNote, cfNote, dtString);
     576    AddNew('ROLE', [], [], SRole, cfRole, dtString);
     577    AddNew('TITLE', [], [], STitle, cfTitle, dtString);
     578    AddNew('CATEGORIES', [], [], SCategories, cfCategories, dtString);
     579    AddNew('ORG', [], [], SOrganization, cfOrganization, dtString, 0);
     580    AddNew('ORG', [], [], SDepartement, cfDepartment, dtString, 1);
     581    AddNew('ADR', ['HOME'], [], SHomeAddressPostOfficeBox, cfHomeAddressPostOfficeBox, dtString, 0);
     582    AddNew('ADR', ['HOME'], [], SHomeAddressStreetExtended, cfHomeAddressStreetExtended, dtString, 1);
     583    AddNew('ADR', ['HOME'], [], SHomeAddressStreet, cfHomeAddressStreet, dtString, 2);
     584    AddNew('ADR', ['HOME'], [], SHomeAddressCity, cfHomeAddressCity, dtString, 3);
     585    AddNew('ADR', ['HOME'], [], SHomeAddressRegion, cfHomeAddressRegion, dtString, 4);
     586    AddNew('ADR', ['HOME'], [], SHomeAddressPostalCode, cfHomeAddressPostalCode, dtString, 5);
     587    AddNew('ADR', ['HOME'], [], SHomeAddressCountry, cfHomeAddressCountry, dtString, 6);
     588    AddNew('ADR', ['WORK'], [], SWorkAddressPostOfficeBox, cfWorkAddressPostOfficeBox, dtString, 0);
     589    AddNew('ADR', ['WORK'], [], SWorkAddressStreetExtended, cfWorkAddressStreetExtended, dtString, 1);
     590    AddNew('ADR', ['WORK'], [], SWorkAddressStreet, cfWorkAddressStreet, dtString, 2);
     591    AddNew('ADR', ['WORK'], [], SWorkAddressCity, cfWorkAddressCity, dtString, 3);
     592    AddNew('ADR', ['WORK'], [], SWorkAddressRegion, cfWorkAddressRegion, dtString, 4);
     593    AddNew('ADR', ['WORK'], [], SWorkAddressPostalCode, cfWorkAddressPostalCode, dtString, 5);
     594    AddNew('ADR', ['WORK'], [], SWorkAddressCountry, cfWorkAddressCountry, dtString, 6);
     595    AddNew('X-TIMES_CONTACTED', [], [], STimesContacted, cfXTimesContacted, dtString);
     596    AddNew('X-LAST_TIME_CONTACTED', [], [], SLastTimeContacted, cfXLastTimeContacted, dtString);
     597    AddNew('PHOTO', [], [], SPhoto, cfPhoto, dtString);
     598    AddNew('X-JABBER', [], [], SJabber, cfXJabber, dtString);
     599    AddNew('BDAY', [], [], SDayOfBirth, cfDayOfBirth, dtString);
     600    AddNew('ANNIVERSARY', [], [], SAnniversary, cfAnniversary, dtString);
     601    AddNew('REV', [], [], SRevision, cfRevision, dtString);
     602    AddNew('UID', [], [], SUniqueIdentifier, cfUid, dtString);
     603    AddNew('URL', [], ['HOME', 'WORK'], SWebAddress, cfUrl, dtString);
     604    AddNew('URL', ['HOME'], [], SWebAddressHome, cfUrlHome, dtString);
     605    AddNew('URL', ['WORK'], [], SWebAddressWork, cfUrlWork, dtString);
    549606  end;
    550607end;
Note: See TracChangeset for help on using the changeset viewer.