Changeset 31 for trunk


Ignore:
Timestamp:
Nov 25, 2021, 1:18:44 AM (3 years ago)
Author:
chronos
Message:
  • Modified: Store contact properties in general way to support also user defined properties and unknown attributes.
  • Added: Show contact image in contact edit window.
Location:
trunk
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormContact.lfm

    r30 r31  
    11object FormContact: TFormContact
    22  Left = 604
    3   Height = 588
    4   Top = 429
    5   Width = 914
     3  Height = 656
     4  Top = 361
     5  Width = 915
    66  Caption = 'Contact'
    7   ClientHeight = 588
    8   ClientWidth = 914
     7  ClientHeight = 656
     8  ClientWidth = 915
    99  DesignTimePPI = 144
    1010  OnClose = FormClose
    … …  
    1414  object PageControlContact: TPageControl
    1515    Left = 10
    16     Height = 508
     16    Height = 576
    1717    Top = 10
    18     Width = 892
     18    Width = 893
    1919    ActivePage = TabSheetAll
    2020    Anchors = [akTop, akLeft, akRight, akBottom]
    … …  
    2424    object TabSheetGeneral: TTabSheet
    2525      Caption = 'General'
    26       ClientHeight = 468
    27       ClientWidth = 882
     26      ClientHeight = 536
     27      ClientWidth = 883
    2828      ParentFont = False
    2929      object Label1: TLabel
    … …  
    113113      end
    114114      object MemoNotes: TMemo
    115         Left = 16
    116         Height = 146
     115        Left = 240
     116        Height = 282
    117117        Top = 230
    118         Width = 846
     118        Width = 623
    119119        Anchors = [akTop, akLeft, akRight, akBottom]
    120120        ParentFont = False
     121        ParentShowHint = False
     122        ScrollBars = ssAutoBoth
    121123        TabOrder = 5
    122124      end
    123125      object Label6: TLabel
    124         Left = 19
     126        Left = 240
    125127        Height = 24
    126128        Top = 202
    … …  
    181183        ParentFont = False
    182184      end
     185      object ImagePhoto: TImage
     186        Left = 16
     187        Height = 208
     188        Top = 232
     189        Width = 207
     190        Proportional = True
     191        Stretch = True
     192      end
     193      object Label23: TLabel
     194        Left = 16
     195        Height = 24
     196        Top = 200
     197        Width = 55
     198        Caption = 'Photo:'
     199        ParentColor = False
     200        ParentFont = False
     201      end
    183202    end
    184203    object TabSheetDetails: TTabSheet
    185204      Caption = 'Details'
    186       ClientHeight = 468
    187       ClientWidth = 882
     205      ClientHeight = 536
     206      ClientWidth = 883
    188207      ParentFont = False
    189208      object Label7: TLabel
    … …  
    428447    object TabSheetAll: TTabSheet
    429448      Caption = 'All fields'
    430       ClientHeight = 468
    431       ClientWidth = 882
     449      ClientHeight = 536
     450      ClientWidth = 883
    432451      OnShow = TabSheetAllShow
    433452      ParentFont = False
    434453      object ListView1: TListView
    435454        Left = 10
    436         Height = 441
     455        Height = 509
    437456        Top = 19
    438         Width = 864
     457        Width = 865
    439458        Anchors = [akTop, akLeft, akRight, akBottom]
    440459        Columns = <       
    441460          item
    442             Caption = 'Item'
    443             Width = 240
     461            Caption = 'Name'
     462            Width = 100
     463          end       
     464          item
     465            Caption = 'Attributes'
     466            Width = 200
    444467          end       
    445468          item
    446469            Caption = 'Value'
    447             Width = 609
     470            Width = 550
    448471          end>
    449472        OwnerData = True
    … …  
    460483  end
    461484  object ButtonCancel: TButton
    462     Left = 787
     485    Left = 788
    463486    Height = 37
    464     Top = 538
     487    Top = 606
    465488    Width = 115
    466489    Anchors = [akRight, akBottom]
    … …  
    471494  end
    472495  object ButtonOk: TButton
    473     Left = 652
     496    Left = 653
    474497    Height = 37
    475     Top = 538
     498    Top = 606
    476499    Width = 119
    477500    Anchors = [akRight, akBottom]

  • trunk/Forms/UFormContact.lrj

    r21 r31  
    1111{"hash":166819690,"name":"tformcontact.label21.caption","sourcebytes":[69,45,109,97,105,108,32,40,87,111,114,107,41,58],"value":"E-mail (Work):"},
    1212{"hash":162456010,"name":"tformcontact.label22.caption","sourcebytes":[66,105,114,116,104,100,97,121,58],"value":"Birthday:"},
     13{"hash":91188010,"name":"tformcontact.label23.caption","sourcebytes":[80,104,111,116,111,58],"value":"Photo:"},
    1314{"hash":181043315,"name":"tformcontact.tabsheetdetails.caption","sourcebytes":[68,101,116,97,105,108,115],"value":"Details"},
    1415{"hash":170160314,"name":"tformcontact.label7.caption","sourcebytes":[80,104,111,110,101,32,40,72,111,109,101,41,58],"value":"Phone (Home):"},
    … …  
    2728{"hash":101155194,"name":"tformcontact.labelorganization.caption","sourcebytes":[79,114,103,97,110,105,122,97,116,105,111,110,58],"value":"Organization:"},
    2829{"hash":113983571,"name":"tformcontact.tabsheetall.caption","sourcebytes":[65,108,108,32,102,105,101,108,100,115],"value":"All fields"},
    29 {"hash":330429,"name":"tformcontact.listview1.columns[0].caption","sourcebytes":[73,116,101,109],"value":"Item"},
    30 {"hash":6063029,"name":"tformcontact.listview1.columns[1].caption","sourcebytes":[86,97,108,117,101],"value":"Value"},
     30{"hash":346165,"name":"tformcontact.listview1.columns[0].caption","sourcebytes":[78,97,109,101],"value":"Name"},
     31{"hash":150815091,"name":"tformcontact.listview1.columns[1].caption","sourcebytes":[65,116,116,114,105,98,117,116,101,115],"value":"Attributes"},
     32{"hash":6063029,"name":"tformcontact.listview1.columns[2].caption","sourcebytes":[86,97,108,117,101],"value":"Value"},
    3133{"hash":77089212,"name":"tformcontact.buttoncancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"},
    3234{"hash":1339,"name":"tformcontact.buttonok.caption","sourcebytes":[79,75],"value":"OK"},

  • trunk/Forms/UFormContact.pas

    r29 r31  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, ActnList, Menus, UContact;
     9  ComCtrls, ActnList, Menus, ExtCtrls, UContact, base64;
    1010
    1111type
    … …  
    4040    EditName: TEdit;
    4141    EditCellPhone: TEdit;
     42    ImagePhoto: TImage;
    4243    Label1: TLabel;
    4344    Label10: TLabel;
    … …  
    5556    Label21: TLabel;
    5657    Label22: TLabel;
     58    Label23: TLabel;
    5759    LabelOrganization: TLabel;
    5860    Label3: TLabel;
    … …  
    110112procedure TFormContact.ListView1Data(Sender: TObject; Item: TListItem);
    111113begin
    112   if Item.Index < Contact.Parent.Fields.Count then
    113   with TContactField(Contact.Parent.Fields[Item.Index]) do begin
    114     Item.Caption := Name;
    115     Item.SubItems.Add(Contact.Fields[Index]);
     114  if Item.Index < Contact.Properties.Count then
     115  with Contact.Properties[Item.Index] do begin
     116    Item.Caption := Contact.Properties[Item.Index].Name;
     117    Item.SubItems.Add(Attributes.DelimitedText);
     118    Item.SubItems.Add(Contact.Properties[Item.Index].Values.DelimitedText);
     119    Item.Data := Contact.Properties[Item.Index];
    116120  end;
    117121end;
    … …  
    125129begin
    126130  if Assigned(Contact) then begin
    127     ListView1.Items.Count := Contact.Parent.Fields.Count;
     131    ListView1.Items.Count := Contact.Properties.Count;
    128132  end else ListView1.Items.Count := 0;
    129133  ListView1.Refresh;
    … …  
    139143begin
    140144  if Assigned(ListView1.Selected) then begin
    141     Contact.Fields[TContactFieldIndex(ListView1.Selected.Index)] :=
    142       InputBox(SFieldEdit, SEditFieldValue, Contact.Fields[TContactFieldIndex(ListView1.Selected.Index)]);
     145    TContactProperty(ListView1.Selected.Data).Values.DelimitedText :=
     146      InputBox(SFieldEdit, SEditFieldValue, TContactProperty(ListView1.Selected.Data).Values.DelimitedText);
    143147  end;
    144148end;
    … …  
    152156
    153157procedure TFormContact.LoadData(Contact: TContact);
     158var
     159  Photo: string;
     160  JpegImage: TJpegImage;
     161  Stream: TMemoryStream;
     162  PhotoProperty: TContactProperty;
    154163begin
    155164  Self.Contact := Contact;
    156   EditName.Text := Contact.FirstName;
    157   EditSurname.Text := Contact.LastName;
    158   EditCellPhone.Text := Contact.TelCell;
    159   EditPhoneHome.Text := Contact.TelHome;
    160   EditPhoneWork.Text := Contact.TelWork;
    161   EditEmail.Text := Contact.EmailHome;
    162   MemoNotes.Lines.Text := Contact.Note;
    163   EditTitle.Text := Contact.Title;
    164   EditOrganization.Text := Contact.Organization;
    165   EditAddress.Text := Contact.AdrHome;
    166   EditEmailHome.Text := Contact.EmailHome;
     165  EditName.Text := Contact.Fields[cfFirstName];
     166  EditSurname.Text := Contact.Fields[cfLastName];
     167  EditCellPhone.Text := Contact.Fields[cfTelCell];
     168  EditPhoneHome.Text := Contact.Fields[cfTelHome];
     169  EditPhoneWork.Text := Contact.Fields[cfTelWork];
     170  EditEmail.Text := Contact.Fields[cfEmail];
     171  MemoNotes.Lines.Text := Contact.Fields[cfNote];
     172  EditTitle.Text := Contact.Fields[cfTitle];
     173  EditOrganization.Text := Contact.Fields[cfOrganization];
     174  EditAddress.Text := Contact.Fields[cfAdrHome];
     175  EditEmailHome.Text := Contact.Fields[cfEmailHome];
     176
     177  ImagePhoto.Picture.Bitmap.Clear;
     178  PhotoProperty := Contact.GetProperty(cfPhoto);
     179  if Assigned(PhotoProperty) then begin
     180    Photo := Contact.Fields[cfPhoto];
     181    if (Photo <> '') and (PhotoProperty.Encoding <> '') then begin
     182      Photo := PhotoProperty.GetDecodedValue;
     183      Stream := TMemoryStream.Create;
     184      Stream.Write(Photo[1], Length(Photo));
     185      Stream.Position := 0;
     186      JpegImage := TJPEGImage.Create;
     187      JpegImage.LoadFromStream(Stream);
     188      ImagePhoto.Picture.Bitmap.SetSize(JpegImage.Width, JpegImage.Height);
     189      ImagePhoto.Picture.Bitmap.Canvas.Draw(0, 0, JpegImage);
     190      JpegImage.Free;
     191      Stream.Free;
     192    end;
     193  end;
    167194end;
    168195
    169196procedure TFormContact.SaveData(Contact: TContact);
    170197begin
    171   Contact.FirstName := EditName.Text;
    172   Contact.LastName := EditSurname.Text;
    173   Contact.TelCell := EditCellPhone.Text;
    174   Contact.TelHome := EditPhoneHome.Text;
    175   Contact.TelWork := EditPhoneWork.Text;
    176   Contact.EmailHome := EditEmail.Text;
    177   Contact.Note := MemoNotes.Lines.Text;
    178   Contact.Title := EditTitle.Text;
    179   Contact.Organization := EditOrganization.Text;
    180   Contact.AdrHome := EditAddress.Text;
    181   Contact.EmailHome := EditEmailHome.Text;
     198  Contact.Fields[cfFirstName] := EditName.Text;
     199  Contact.Fields[cfLastName] := EditSurname.Text;
     200  Contact.Fields[cfTelCell] := EditCellPhone.Text;
     201  Contact.Fields[cfTelHome] := EditPhoneHome.Text;
     202  Contact.Fields[cfTelWork] := EditPhoneWork.Text;
     203  Contact.Fields[cfEmail] := EditEmail.Text;
     204  Contact.Fields[cfNote] := MemoNotes.Lines.Text;
     205  Contact.Fields[cfTitle] := EditTitle.Text;
     206  Contact.Fields[cfOrganization] := EditOrganization.Text;
     207  Contact.Fields[cfAdrHome] := EditAddress.Text;
     208  Contact.Fields[cfEmailHome] := EditEmailHome.Text;
    182209end;
    183210

  • trunk/Forms/UFormContacts.pas

    r29 r31  
    7070  if Assigned(Contacts) and (Item.Index < Contacts.Count) then
    7171  with TContact(Contacts[Item.Index]) do begin
    72     Item.Caption := FullName;
    73     Item.SubItems.Add(FirstName);
    74     Item.SubItems.Add(MiddleName);
    75     Item.SubItems.Add(LastName);
    76     Item.SubItems.Add(TelCell);
    77     Item.SubItems.Add(TelHome);
     72    Item.Caption := Fields[cfFullName];
     73    Item.SubItems.Add(Fields[cfFirstName]);
     74    Item.SubItems.Add(Fields[cfMiddleName]);
     75    Item.SubItems.Add(Fields[cfLastName]);
     76    Item.SubItems.Add(Fields[cfTelCell]);
     77    Item.SubItems.Add(Fields[cfTelHome]);
    7878    Item.Data := Contacts[Item.Index];
    7979  end;

  • trunk/Forms/UFormError.pas

    r30 r31  
    1717    procedure FormCreate(Sender: TObject);
    1818    procedure FormShow(Sender: TObject);
    19   private
    20 
    21   public
    22 
    2319  end;
    2420

  • trunk/Forms/UFormGenerate.pas

    r29 r31  
    4646  for I := 1 to SpinEditCount.Value do begin
    4747    Contact := Contacts.AddNew;
    48     Contact.FirstName := 'First ' + IntToStr(Random(10000));
    49     Contact.LastName := 'Last ' + IntToStr(Random(10000));
    50     Contact.FullName := 'FullName ' + IntToStr(Random(100));
    51     Contact.TelCell := IntToStr(Random(1000000000));
    52     Contact.TelHome := IntToStr(Random(1000000000));
     48    Contact.Fields[cfFirstName] := 'First ' + IntToStr(Random(10000));
     49    Contact.Fields[cfLastName] := 'Last ' + IntToStr(Random(10000));
     50    Contact.Fields[cfFullName] := 'FullName ' + IntToStr(Random(100));
     51    Contact.Fields[cfTelCell] := IntToStr(Random(1000000000));
     52    Contact.Fields[cfTelHome] := IntToStr(Random(1000000000));
    5353  end;
    5454  Close;

  • trunk/Languages/vCardStudio.cs.po

    r30 r31  
    155155msgstr "Narozeniny:"
    156156
     157#: tformcontact.label23.caption
     158msgid "Photo:"
     159msgstr ""
     160
    157161#: tformcontact.label3.caption
    158162msgid "Phone:"
    … …  
    188192
    189193#: tformcontact.listview1.columns[0].caption
    190 msgid "Item"
     194#, fuzzy
     195#| msgid "Item"
     196msgid "Name"
    191197msgstr "Položka"
    192198
    193199#: tformcontact.listview1.columns[1].caption
     200#, fuzzy
     201#| msgid "Value"
     202msgctxt "tformcontact.listview1.columns[1].caption"
     203msgid "Attributes"
     204msgstr "Hodnota"
     205
     206#: tformcontact.listview1.columns[2].caption
     207msgctxt "tformcontact.listview1.columns[2].caption"
    194208msgid "Value"
    195 msgstr "Hodnota"
     209msgstr ""
    196210
    197211#: tformcontact.tabsheetall.caption
    198212msgid "All fields"
    199 msgstr "Všechny pole"
     213msgstr "Všechna pole"
    200214
    201215#: tformcontact.tabsheetdetails.caption
    … …  
    230244#: tformcontacts.listview1.columns[0].caption
    231245msgid "Full Name"
    232 msgstr "Křestní jméno"
     246msgstr "Celé jméno"
    233247
    234248#: tformcontacts.listview1.columns[1].caption
    235249msgid "First name"
    236 msgstr "Prostřední jméno"
     250msgstr "Křestní jméno"
    237251
    238252#: tformcontacts.listview1.columns[2].caption
    … …  
    244258msgctxt "tformcontacts.listview1.columns[3].caption"
    245259msgid "Last Name"
    246 msgstr "Příjimení"
     260msgstr "Příjmení"
    247261
    248262#: tformcontacts.listview1.columns[4].caption
    … …  
    364378msgstr "DPI:"
    365379
     380#: ucontact.sfieldindexnotdefined
     381msgid "Field index not defined"
     382msgstr "Index pole nenalezen"
     383
    366384#: ucontact.sfoundblockendwithoutblockstart
    367385msgid "Found block end without block start"
    … …  
    438456msgid "Modified"
    439457msgstr "Upraveno"
     458

  • trunk/Languages/vCardStudio.po

    r30 r31  
    141141msgstr ""
    142142
     143#: tformcontact.label23.caption
     144msgid "Photo:"
     145msgstr ""
     146
    143147#: tformcontact.label3.caption
    144148msgid "Phone:"
    … …  
    174178
    175179#: tformcontact.listview1.columns[0].caption
    176 msgid "Item"
     180msgid "Name"
    177181msgstr ""
    178182
    179183#: tformcontact.listview1.columns[1].caption
     184msgctxt "tformcontact.listview1.columns[1].caption"
     185msgid "Attributes"
     186msgstr ""
     187
     188#: tformcontact.listview1.columns[2].caption
     189msgctxt "tformcontact.listview1.columns[2].caption"
    180190msgid "Value"
    181191msgstr ""
    … …  
    348358msgstr ""
    349359
     360#: ucontact.sfieldindexnotdefined
     361msgid "Field index not defined"
     362msgstr ""
     363
    350364#: ucontact.sfoundblockendwithoutblockstart
    351365msgid "Found block end without block start"

  • trunk/UContact.pas

    r30 r31  
    66
    77uses
    8   Classes, SysUtils, fgl, Dialogs, UDataFile, LazUTF8, base64;
     8  Classes, SysUtils, fgl, Dialogs, UDataFile, LazUTF8, Base64;
    99
    1010type
    … …  
    1616
    1717  TContactFieldIndex = (cfFirstName, cfMiddleName, cfLastName, cfTitleBefore,
    18     cfTitleAfter, cfFullName, cfTelPrefCell,
    19     cfTelCell, cfTelHome, cfTelHome2, cfTelWork, cfTelVoip,
    20     cfTelPrefWorkVoice, cfTelPrefHomeVoice, cfTelHomeVoice, cfTelWorkVoice,
    21     cfTelVoice, cfTelMain,
     18    cfTitleAfter, cfFullName, cfTelCell, cfTelHome, cfTelHome2, cfTelWork, cfTelVoip,
     19    cfTelMain, cfEmail,
    2220    cfEmailHome, cfEmailInternet, cfNickName, cfNote, cfRole, cfTitle,
    2321    cfCategories, cfOrganization, cfAdrHome, cfHomeAddressStreet,
    2422    cfHomeAddressCity, cfHomeAddressCountry, cfXTimesContacted,
    25     cfXLastTimeContacted, cfPhoto, cfXJabber);
     23    cfXLastTimeContacted, cfPhoto, cfXJabber, cfDayOfBirth, cfRevision,
     24    cfVersion);
    2625
    2726  TContactField = class
     27    SysName: string;
     28    Groups: TStringArray;
     29    Title: string;
     30    Index: TContactFieldIndex;
     31    ValueIndex: Integer;
     32    DataType: TDataType;
     33  end;
     34
     35  { TContactFields }
     36
     37  TContactFields = class(TFPGObjectList<TContactField>)
     38    function AddNew(Name: string; Groups: TStringArray; Title: string; Index: TContactFieldIndex; DataType:
     39      TDataType; ValueIndex: Integer = -1): TContactField;
     40    function GetByIndex(Index: TContactFieldIndex): TContactField;
     41    procedure LoadToStrings(AItems: TStrings);
     42  end;
     43
     44  { TContactProperty }
     45
     46  TContactProperty = class
    2847    Name: string;
    29     Index: TContactFieldIndex;
    30     DataType: TDataType;
    31   end;
    32 
    33   { TContactFields }
    34 
    35   TContactFields = class(TFPGObjectList<TContactField>)
    36     function AddNew(Name: string; Index: TContactFieldIndex; DataType:
    37       TDataType): TContactField;
    38     procedure LoadToStrings(AItems: TStrings);
     48    Attributes: TStringList;
     49    Values: TStringList;
     50    Encoding: string;
     51    Charset: string;
     52    procedure EvaluateAttributes;
     53    function GetDecodedValue: string;
     54    function MatchNameGroups(AName: string; Groups: TStringArray): Boolean;
     55    procedure Assign(Source: TContactProperty);
     56    constructor Create;
     57    destructor Destroy; override;
     58  end;
     59
     60  { TContactProperties }
     61
     62  TContactProperties = class(TFPGObjectList<TContactProperty>)
     63    function GetByName(Name: string): TContactProperty;
     64    function GetByNameGroups(Name: string; Groups: TStringArray): TContactProperty;
     65    function GetByNameGroupsMultiple(Name: string; Groups: TStringArray): TContactProperties;
    3966  end;
    4067
    … …  
    4673    procedure SetField(Index: TContactFieldIndex; AValue: string);
    4774  public
     75    Properties: TContactProperties;
    4876    Parent: TContactsFile;
    49     Version: string;
    50     FirstName: string;
    51     MiddleName: string;
    52     LastName: string;
    53     TitleBefore: string;
    54     TitleAfter: string;
    55     FullName: string;
    56     TelPrefCell: string;
    57     TelCell: string;
    58     TelHome: string;
    59     TelHome2: string;
    60     TelWork: string;
    61     TelVoip: string;
    62     TelPrefWorkVoice: string;
    63     TelPrefHomeVoice: string;
    64     TelHomeVoice: string;
    65     TelWorkVoice: string;
    66     TelVoice: string;
    67     TelMain: string;
    68     EmailHome: string;
    69     EmailInternet: string;
    70     NickName: string;
    71     Note: string;
    72     Role: string;
    73     Title: string;
    74     Categories: string;
    75     Organization: string;
    76     AdrHome: string;
    77     HomeAddressStreet: string;
    78     HomeAddressCity: string;
    79     HomeAddressCountry: string;
    80     XTimesContacted: string;
    81     XLastTimeContacted: string;
    82     Photo: string;
    83     XJabber: string;
     77    function GetProperty(Index: TContactFieldIndex): TContactProperty;
    8478    procedure Assign(Source: TContact);
    8579    function UpdateFrom(Source: TContact): Boolean;
     80    constructor Create;
     81    destructor Destroy; override;
    8682    property Fields[Index: TContactFieldIndex]: string read GetField write SetField;
    8783  end;
    … …  
    10197  private
    10298    FOnError: TErrorEvent;
    103     function GetNext(var Text: string; Separator: string): string;
    10499    procedure InitFields;
    105100    procedure Error(Text: string; Line: Integer);
     101    function NewItem(Key, Value: string): string;
    106102  public
    107103    Fields: TContactFields;
    … …  
    126122  SFoundPropertiesBeforeBlockStart = 'Found properties before the start of block';
    127123  SFoundBlockEndWithoutBlockStart = 'Found block end without block start';
    128 
    129 { TContacts }
    130 
    131 function TContacts.AddNew: TContact;
    132 begin
    133   Result := TContact.Create;
    134   Result.Parent := ContactsFile;
    135   Add(Result);
    136 end;
    137 
    138 function TContacts.Search(FullName: string): TContact;
    139 var
    140   Contact: TContact;
    141 begin
    142   Result := nil;
    143   for Contact in Self do
    144     if Contact.FullName = FullName then begin
    145       Result := Contact;
    146       Break;
    147     end;
    148 end;
    149 
    150 function TContacts.ToString: ansistring;
    151 var
    152   I: Integer;
    153 begin
    154   Result := '';
    155   for I := 0 to Count - 1 do begin
    156     if I > 0 then Result := Result + ', ';
    157     Result := Result + TContact(Items[I]).FullName;
    158   end;
    159 end;
    160 
    161 { TContactFields }
    162 
    163 function TContactFields.AddNew(Name: string; Index: TContactFieldIndex;
    164   DataType: TDataType): TContactField;
    165 begin
    166   Result := TContactField.Create;
    167   Result.Name := Name;
    168   Result.Index := Index;
    169   Result.DataType := DataType;
    170   Add(Result);
    171 end;
    172 
    173 procedure TContactFields.LoadToStrings(AItems: TStrings);
    174 var
    175   I: Integer;
    176 begin
    177   while AItems.Count < Count do AItems.Add('');
    178   while AItems.Count > Count do AItems.Delete(AItems.Count - 1);
    179   for I := 0 to Count - 1 do
    180     AItems[I] := TContactField(Items[I]).Name;
    181 end;
    182 
    183 { TContact }
    184 
    185 function TContact.GetField(Index: TContactFieldIndex): string;
    186 begin
    187   case Index of
    188     cfFirstName: Result := FirstName;
    189     cfMiddleName: Result := MiddleName;
    190     cfLastName: Result := LastName;
    191     cfTitleBefore: Result := TitleBefore;
    192     cfTitleAfter: Result := TitleAfter;
    193     cfFullName: Result := FullName;
    194     cfTelPrefCell: Result := TelPrefCell;
    195     cfTelCell: Result := TelCell;
    196     cfTelHome: Result := TelHome;
    197     cfTelHome2: Result := TelHome2;
    198     cfTelWork: Result := TelWork;
    199     cfTelVoip: Result := TelVoip;
    200     cfTelPrefWorkVoice: Result := TelPrefWorkVoice;
    201     cfTelPrefHomeVoice: Result := TelPrefHomeVoice;
    202     cfTelHomeVoice: Result := TelHomeVoice;
    203     cfTelWorkVoice: Result := TelWorkVoice;
    204     cfTelVoice: Result := TelVoice;
    205     cfTelMain: Result := TelMain;
    206     cfEmailHome: Result := EmailHome;
    207     cfEmailInternet: Result := EmailInternet;
    208     cfNickName: Result := NickName;
    209     cfNote: Result := Note;
    210     cfRole: Result := Role;
    211     cfTitle: Result := Title;
    212     cfCategories: Result := Categories;
    213     cfOrganization: Result := Organization;
    214     cfAdrHome: Result := AdrHome;
    215     cfHomeAddressStreet: Result := HomeAddressStreet;
    216     cfHomeAddressCity: Result := HomeAddressCity;
    217     cfHomeAddressCountry: Result := HomeAddressCountry;
    218     cfXTimesContacted: Result := XTimesContacted;
    219     cfXLastTimeContacted: Result := XLastTimeContacted;
    220     cfPhoto: Result := Photo;
    221     cfXJabber: Result := XJabber;
    222     else raise Exception.Create(SUnsupportedContactFieldsIndex);
    223   end;
    224 end;
    225 
    226 procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
    227 begin
    228   case Index of
    229     cfFirstName: FirstName := AValue;
    230     cfMiddleName: MiddleName := AValue;
    231     cfLastName: LastName := AValue;
    232     cfTitleBefore: TitleBefore := AValue;
    233     cfTitleAfter: TitleAfter := AValue;
    234     cfFullName: FullName := AValue;
    235     cfTelPrefCell: TelPrefCell := AValue;
    236     cfTelCell: TelCell := AValue;
    237     cfTelHome: TelHome := AValue;
    238     cfTelHome2: TelHome2 := AValue;
    239     cfTelWork: TelWork := AValue;
    240     cfTelVoip: TelVoip := AValue;
    241     cfTelPrefWorkVoice: TelPrefWorkVoice := AValue;
    242     cfTelPrefHomeVoice: TelPrefHomeVoice := AValue;
    243     cfTelHomeVoice: TelHomeVoice := AValue;
    244     cfTelWorkVoice: TelWorkVoice := AValue;
    245     cfTelVoice: TelVoice := AValue;
    246     cfTelMain: TelMain := AValue;
    247     cfEmailHome: EmailHome := AValue;
    248     cfEmailInternet: EmailInternet := AValue;
    249     cfNickName: NickName := AValue;
    250     cfNote: Note := AValue;
    251     cfRole: Role := AValue;
    252     cfTitle: Title := AValue;
    253     cfCategories: Categories := AValue;
    254     cfOrganization: Organization := AValue;
    255     cfAdrHome: AdrHome := AValue;
    256     cfHomeAddressStreet: HomeAddressStreet := AValue;
    257     cfHomeAddressCity: HomeAddressCity := AValue;
    258     cfHomeAddressCountry: HomeAddressCountry := AValue;
    259     cfXTimesContacted: XTimesContacted := AValue;
    260     cfXLastTimeContacted: XLastTimeContacted := AValue;
    261     cfPhoto: Photo := AValue;
    262     cfXJabber: XJabber := AValue;
    263     else raise Exception.Create(SUnsupportedContactFieldsIndex);
    264   end;
    265 end;
    266 
    267 procedure TContact.Assign(Source: TContact);
    268 begin
    269   Version := Source.Version;
    270   FirstName := Source.FirstName;
    271   MiddleName := Source.MiddleName;
    272   LastName := Source.LastName;
    273   TitleBefore := Source.TitleBefore;
    274   TitleAfter := Source.TitleAfter;
    275   FullName := Source.FullName;
    276   TelPrefCell := Source.TelPrefCell;
    277   TelCell := Source.TelCell;
    278   TelHome := Source.TelHome;
    279   TelHome2 := Source.TelHome2;
    280   TelWork := Source.TelWork;
    281   TelVoip := Source.TelVoip;
    282   TelPrefWorkVoice := Source.TelPrefWorkVoice;
    283   TelPrefHomeVoice := Source.TelPrefHomeVoice;
    284   TelHomeVoice := Source.TelHomeVoice;
    285   TelWorkVoice := Source.TelWorkVoice;
    286   EmailHome := Source.EmailHome;
    287   EmailInternet := Source.EmailInternet;
    288   NickName := Source.NickName;
    289   Note := Source.Note;
    290   Role := Source.Role;
    291   Title := Source.Title;
    292   Categories := Source.Categories;
    293   Organization := Source.Organization;
    294   AdrHome := Source.AdrHome;
    295   HomeAddressStreet := Source.HomeAddressStreet;
    296   HomeAddressCity := Source.HomeAddressCity;
    297   HomeAddressCountry := Source.HomeAddressCountry;
    298   XTimesContacted := Source.XTimesContacted;
    299   XLastTimeContacted := Source.XLastTimeContacted;
    300   Photo := Source.Photo;
    301   XJabber := Source.XJabber;
    302 end;
    303 
    304 function TContact.UpdateFrom(Source: TContact): Boolean;
    305 var
    306   I: Integer;
    307 begin
    308   Result := False;
    309   for I := 0 to Parent.Fields.Count - 1 do begin
    310     if (Source.Fields[TContactField(Parent.Fields[I]).Index] <> '') and
    311       (Source.Fields[TContactField(Parent.Fields[I]).Index] <>
    312       Fields[TContactField(Parent.Fields[I]).Index]) then begin
    313         Result := True;
    314         Fields[TContactField(Parent.Fields[I]).Index] := Source.Fields[TContactField(Parent.Fields[I]).Index];
    315       end;
    316   end;
    317 end;
    318 
    319 { TContactsFile }
    320 
    321 function TContactsFile.GetNext(var Text: string; Separator: string): string;
     124  SFieldIndexNotDefined = 'Field index not defined';
     125
     126function GetNext(var Text: string; Separator: string): string;
    322127begin
    323128  if Pos(Separator, Text) > 0 then begin
    … …  
    330135end;
    331136
    332 procedure TContactsFile.InitFields;
    333 begin
    334   with Fields do begin
    335     AddNew('First Name', cfFirstName, dtString);
    336     AddNew('Middle Name', cfMiddleName, dtString);
    337     AddNew('Last Name', cfLastName, dtString);
    338     AddNew('Title Before', cfTitleBefore, dtString);
    339     AddNew('Title After', cfTitleAfter, dtString);
    340     AddNew('Full Name', cfFullName, dtString);
    341     AddNew('Preferred cell phone', cfTelPrefCell, dtString);
    342     AddNew('Cell phone', cfTelCell, dtString);
    343     AddNew('Home phone', cfTelHome, dtString);
    344     AddNew('Home phone 2', cfTelHome2, dtString);
    345     AddNew('Home work', cfTelWork, dtString);
    346     AddNew('Tel Voip', cfTelVoip, dtString);
    347     AddNew('Tel Pref Work Voice', cfTelPrefWorkVoice, dtString);
    348     AddNew('Tel Pref Home Voice', cfTelPrefHomeVoice, dtString);
    349     AddNew('Tel Home Voice', cfTelHomeVoice, dtString);
    350     AddNew('Tel Work Voice', cfTelWorkVoice, dtString);
    351     AddNew('Tel Voice', cfTelVoice, dtString);
    352     AddNew('Tel Main', cfTelMain, dtString);
    353     AddNew('Email Home', cfEmailHome, dtString);
    354     AddNew('Email Internet', cfEmailInternet, dtString);
    355     AddNew('Nick Name', cfNickName, dtString);
    356     AddNew('Note', cfNote, dtString);
    357     AddNew('Role', cfRole, dtString);
    358     AddNew('Title', cfTitle, dtString);
    359     AddNew('Categories', cfCategories, dtString);
    360     AddNew('Organization', cfOrganization, dtString);
    361     AddNew('Home Address', cfAdrHome, dtString);
    362     AddNew('Home Address Street', cfHomeAddressStreet, dtString);
    363     AddNew('Home Address City', cfHomeAddressCity, dtString);
    364     AddNew('Home Address Country', cfHomeAddressCountry, dtString);
    365     AddNew('Times Contacted', cfXTimesContacted, dtString);
    366     AddNew('Last Time Contacted', cfXLastTimeContacted, dtString);
    367     AddNew('Photo', cfPhoto, dtString);
    368     AddNew('Jabber', cfXJabber, dtString);
    369   end;
    370 end;
    371 
    372 procedure TContactsFile.Error(Text: string; Line: Integer);
    373 begin
    374   if Assigned(FOnError) then FOnError(Text, Line);
    375 end;
    376 
    377 function TContactsFile.GetFileName: string;
    378 begin
    379   Result := SVCardFile;
    380 end;
    381 
    382 function TContactsFile.GetFileExt: string;
    383 begin
    384   Result := '.vcf';
    385 end;
    386 
    387 function TContactsFile.GetFileFilter: string;
    388 begin
    389   Result := GetFileName + ' (' + GetFileExt + ')|*' + GetFileExt + '|' + inherited;
    390 end;
    391 
    392 procedure TContactsFile.SaveToFile(FileName: string);
    393 var
    394   Output: TStringList;
    395   I: Integer;
    396   PhotoBase64: string;
    397   Line: string;
    398 
    399137function IsAsciiString(Text: string): Boolean;
    400138var
    … …  
    409147end;
    410148
    411 function NewItem(Key, Value: string): string;
     149{ TContactProperties }
     150
     151function TContactProperties.GetByName(Name: string): TContactProperty;
     152var
     153  I: Integer;
     154begin
     155  I := 0;
     156  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
     157  if I < Count then Result := Items[I]
     158    else Result := nil;
     159end;
     160
     161function TContactProperties.GetByNameGroups(Name: string; Groups: TStringArray
     162  ): TContactProperty;
     163var
     164  I: Integer;
     165begin
     166  I := 0;
     167  while (I < Count) and not Items[I].MatchNameGroups(Name, Groups) do Inc(I);
     168  if I < Count then Result := Items[I]
     169    else Result := nil;
     170end;
     171
     172function TContactProperties.GetByNameGroupsMultiple(Name: string;
     173  Groups: TStringArray): TContactProperties;
     174var
     175  I: Integer;
     176begin
     177  Result := TContactProperties.Create(False);
     178  for I := 0 to Count - 1 do
     179  if Items[I].MatchNameGroups(Name, Groups) then
     180    Result.Add(Items[I]);
     181end;
     182
     183{ TContactProperty }
     184
     185procedure TContactProperty.EvaluateAttributes;
     186begin
     187  if Attributes.IndexOfName('ENCODING') <> -1 then
     188    Encoding := Attributes.Values['ENCODING']
     189    else Encoding := '';
     190  if Attributes.IndexOfName('CHARSET') <> -1 then
     191    Charset := Attributes.Values['CHARSET']
     192    else Charset := '';
     193end;
     194
     195function TContactProperty.GetDecodedValue: string;
     196begin
     197  if Encoding = 'BASE64' then
     198    Result := DecodeStringBase64(Values.DelimitedText)
     199  else
     200  if Encoding = 'QUOTED-PRINTABLE' then
     201    Result := Values.DelimitedText
     202  else Result := '';
     203end;
     204
     205function TContactProperty.MatchNameGroups(AName: string; Groups: TStringArray
     206  ): Boolean;
     207var
     208  I: Integer;
     209begin
     210  Result := Name = AName;
     211  if Result then begin
     212    for I := 0 to Length(Groups) - 1 do
     213      if Attributes.IndexOf(Groups[I]) = -1 then begin
     214        Result := False;
     215        Break;
     216      end;
     217  end;
     218end;
     219
     220procedure TContactProperty.Assign(Source: TContactProperty);
     221begin
     222  Name := Source.Name;
     223  Attributes.Assign(Source.Attributes);
     224  Values.Assign(Source.Values);
     225end;
     226
     227constructor TContactProperty.Create;
     228begin
     229  Attributes := TStringList.Create;
     230  Attributes.Delimiter := ';';
     231  Attributes.NameValueSeparator := '=';
     232  Attributes.StrictDelimiter := True;
     233  Values := TStringList.Create;
     234  Values.Delimiter := ';';
     235  Values.NameValueSeparator := '=';
     236  Values.StrictDelimiter := True;
     237end;
     238
     239destructor TContactProperty.Destroy;
     240begin
     241  FreeAndNil(Values);
     242  FreeAndNil(Attributes);
     243  inherited;
     244end;
     245
     246{ TContacts }
     247
     248function TContacts.AddNew: TContact;
     249begin
     250  Result := TContact.Create;
     251  Result.Parent := ContactsFile;
     252  Add(Result);
     253end;
     254
     255function TContacts.Search(FullName: string): TContact;
     256var
     257  Contact: TContact;
     258begin
     259  Result := nil;
     260  for Contact in Self do
     261    if Contact.Fields[cfFullName] = FullName then begin
     262      Result := Contact;
     263      Break;
     264    end;
     265end;
     266
     267function TContacts.ToString: ansistring;
     268var
     269  I: Integer;
     270begin
     271  Result := '';
     272  for I := 0 to Count - 1 do begin
     273    if I > 0 then Result := Result + ', ';
     274    Result := Result + Items[I].Fields[cfFullName];
     275  end;
     276end;
     277
     278{ TContactFields }
     279
     280function TContactFields.AddNew(Name: string; Groups: TStringArray; Title: string; Index: TContactFieldIndex;
     281  DataType: TDataType; ValueIndex: Integer = -1): TContactField;
     282begin
     283  Result := TContactField.Create;
     284  Result.SysName := Name;
     285  Result.Groups := Groups;
     286  Result.Title := Title;
     287  Result.Index := Index;
     288  Result.ValueIndex := ValueIndex;
     289  Result.DataType := DataType;
     290  Add(Result);
     291end;
     292
     293function TContactFields.GetByIndex(Index: TContactFieldIndex): TContactField;
     294var
     295  I: Integer;
     296begin
     297  I := 0;
     298  while (I < Count) and (Items[I].Index <> Index) do Inc(I);
     299  if I < Count then Result := Items[I]
     300    else Result := nil;
     301end;
     302
     303procedure TContactFields.LoadToStrings(AItems: TStrings);
     304var
     305  I: Integer;
     306begin
     307  while AItems.Count < Count do AItems.Add('');
     308  while AItems.Count > Count do AItems.Delete(AItems.Count - 1);
     309  for I := 0 to Count - 1 do
     310    AItems[I] := Items[I].Title;
     311end;
     312
     313{ TContact }
     314
     315function TContact.GetField(Index: TContactFieldIndex): string;
     316var
     317  Prop: TContactProperty;
     318  Field: TContactField;
     319begin
     320  Prop := GetProperty(Index);
     321  if Assigned(Prop) then begin
     322    Field := Parent.Fields.GetByIndex(Index);
     323    if Field.ValueIndex <> -1 then begin
     324      if Field.ValueIndex < Prop.Values.Count then
     325        Result := Prop.Values.Strings[Field.ValueIndex]
     326        else Result := '';
     327    end else Result := Prop.Values.DelimitedText;
     328  end else Result := '';
     329end;
     330
     331procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
     332var
     333  Prop: TContactProperty;
     334  Field: TContactField;
     335  I: Integer;
     336begin
     337  Field := Parent.Fields.GetByIndex(Index);
     338  if Assigned(Field) then begin
     339    Prop := Properties.GetByNameGroups(Field.SysName, Field.Groups);
     340    if not Assigned(Prop) then begin
     341      Prop := TContactProperty.Create;
     342      Prop.Name := Field.SysName;
     343      for I := 0 to Length(Field.Groups) - 1 do
     344        Prop.Attributes.Add(Field.Groups[I]);
     345      Properties.Add(Prop);
     346    end;
     347    if Field.ValueIndex <> -1 then begin
     348      while Prop.Values.Count <= Field.ValueIndex do Prop.Values.Add('');
     349      Prop.Values.Strings[Field.ValueIndex] := AValue
     350    end else Prop.Values.DelimitedText := AValue;
     351  end else raise Exception.Create(SFieldIndexNotDefined);
     352end;
     353
     354function TContact.GetProperty(Index: TContactFieldIndex): TContactProperty;
     355var
     356  Prop: TContactProperty;
     357  Field: TContactField;
     358begin
     359  Field := Parent.Fields.GetByIndex(Index);
     360  if Assigned(Field) then begin
     361    Result := Properties.GetByNameGroups(Field.SysName, Field.Groups);
     362  end else raise Exception.Create(SFieldIndexNotDefined);
     363end;
     364
     365procedure TContact.Assign(Source: TContact);
     366begin
     367  Properties.Assign(Source.Properties);
     368end;
     369
     370function TContact.UpdateFrom(Source: TContact): Boolean;
     371var
     372  I: Integer;
     373begin
     374  Result := False;
     375  for I := 0 to Parent.Fields.Count - 1 do begin
     376    if (Source.Fields[Parent.Fields[I].Index] <> '') and
     377      (Source.Fields[Parent.Fields[I].Index] <>
     378      Fields[Parent.Fields[I].Index]) then begin
     379        Result := True;
     380        Fields[Parent.Fields[I].Index] := Source.Fields[Parent.Fields[I].Index];
     381      end;
     382  end;
     383end;
     384
     385constructor TContact.Create;
     386begin
     387  Properties := TContactProperties.Create;
     388end;
     389
     390destructor TContact.Destroy;
     391begin
     392  FreeAndNil(Properties);
     393  inherited;
     394end;
     395
     396{ TContactsFile }
     397
     398procedure TContactsFile.InitFields;
     399begin
     400  with Fields do begin
     401    AddNew('N', [], 'Last Name', cfLastName, dtString, 0);
     402    AddNew('N', [], 'First Name', cfFirstName, dtString, 1);
     403    AddNew('N', [], 'Middle Name', cfMiddleName, dtString, 2);
     404    AddNew('N', [], 'Title Before', cfTitleBefore, dtString, 3);
     405    AddNew('N', [], 'Title After', cfTitleAfter, dtString, 4);
     406    AddNew('FN', [], 'Full Name', cfFullName, dtString);
     407    AddNew('TEL', ['CELL'], 'Cell phone', cfTelCell, dtString);
     408    AddNew('TEL', ['HOME'], 'Home phone', cfTelHome, dtString);
     409    AddNew('TEL', ['HOME2'], 'Home phone 2', cfTelHome2, dtString);
     410    AddNew('TEL', ['WORK'], 'Home work', cfTelWork, dtString);
     411    AddNew('TEL', ['VOIP'], 'Tel VoIP', cfTelVoip, dtString);
     412    AddNew('TEL', ['MAIN'], 'Tel Main', cfTelMain, dtString);
     413    AddNew('EMAIL', [], 'Email', cfEmail, dtString);
     414    AddNew('EMAIL', ['HOME'], 'Email Home', cfEmailHome, dtString);
     415    AddNew('EMAIL', ['INTERNET'], 'Email Internet', cfEmailInternet, dtString);
     416    AddNew('X-NICKNAME', [], 'Nick Name', cfNickName, dtString);
     417    AddNew('NOTE', [], 'Note', cfNote, dtString);
     418    AddNew('ROLE', [], 'Role', cfRole, dtString);
     419    AddNew('TITLE', [], 'Title', cfTitle, dtString);
     420    AddNew('CATEGORIES', [], 'Categories', cfCategories, dtString);
     421    AddNew('ORG', [], 'Organization', cfOrganization, dtString);
     422    AddNew('ADR', ['HOME'], 'Home Address', cfAdrHome, dtString);
     423    AddNew('ADR', ['HOME'], 'Home Address Street', cfHomeAddressStreet, dtString, 1);
     424    AddNew('ADR', ['HOME'], 'Home Address City', cfHomeAddressCity, dtString, 2);
     425    AddNew('ADR', ['HOME'], 'Home Address Country', cfHomeAddressCountry, dtString, 3);
     426    AddNew('X-TIMES_CONTACTED', [], 'Times Contacted', cfXTimesContacted, dtString);
     427    AddNew('X-LAST_TIME_CONTACTED', [], 'Last Time Contacted', cfXLastTimeContacted, dtString);
     428    AddNew('PHOTO', [], 'Photo', cfPhoto, dtString);
     429    AddNew('X-JABBER', [], 'Jabber', cfXJabber, dtString);
     430    AddNew('BDAY', [], 'Day of birth', cfDayOfBirth, dtString);
     431    AddNew('REV', [], 'Revision', cfRevision, dtString);
     432  end;
     433end;
     434
     435procedure TContactsFile.Error(Text: string; Line: Integer);
     436begin
     437  if Assigned(FOnError) then FOnError(Text, Line);
     438end;
     439
     440function TContactsFile.GetFileName: string;
     441begin
     442  Result := SVCardFile;
     443end;
     444
     445function TContactsFile.GetFileExt: string;
     446begin
     447  Result := '.vcf';
     448end;
     449
     450function TContactsFile.GetFileFilter: string;
     451begin
     452  Result := GetFileName + ' (' + GetFileExt + ')|*' + GetFileExt + '|' + inherited;
     453end;
     454
     455function TContactsFile.NewItem(Key, Value: string): string;
    412456var
    413457  Charset: string;
    … …  
    418462end;
    419463
     464procedure TContactsFile.SaveToFile(FileName: string);
     465var
     466  Output: TStringList;
     467  I: Integer;
     468  J: Integer;
     469  Value: string;
     470  NameText: string;
    420471begin
    421472  inherited;
    … …  
    423474    Output := TStringList.Create;
    424475    for I := 0 to Contacts.Count - 1 do
    425     with TContact(Contacts[I]), Output do begin
     476    with Contacts[I], Output do begin
    426477      Add('BEGIN:VCARD');
    427       if Version <> '' then Add('VERSION:' + Version);
    428       if XTimesContacted <> '' then Add('X-TIMES_CONTACTED:' + XTimesContacted);
    429       if XLastTimeContacted <> '' then Add('X-LAST_TIME_CONTACTED:' + XLastTimeContacted);
    430       if (LastName <> '') or (FirstName <> '') or (MiddleName <> '') or (TitleBefore <> '') or (TitleAfter <> '') then
    431         Add(NewItem('N', LastName + ';' + FirstName + ';' + MiddleName + ';' + TitleBefore + ';' + TitleAfter));
    432       if FullName <> '' then Add(NewItem('FN', FullName));
    433       if TelCell <> '' then Add('TEL;CELL:' + TelCell);
    434       if TelPrefCell <> '' then Add('TEL;PREF;CELL:' + TelPrefCell);
    435       if TelHome <> '' then Add('TEL;HOME:' + TelHome);
    436       if TelHome2 <> '' then Add('TEL;HOME2:' + TelHome2);
    437       if TelWork <> '' then Add('TEL;WORK:' + TelWork);
    438       if TelVoip <> '' then Add('TEL;VOIP:' + TelVoip);
    439       if TelPrefWorkVoice <> '' then Add('TEL;PREF;WORK;VOICE:' + TelPrefWorkVoice);
    440       if TelPrefHomeVoice <> '' then Add('TEL;PREF;HOME;VOICE:' + TelPrefHomeVoice);
    441       if TelHomeVoice <> '' then Add('TEL;HOME;VOICE:' + TelHomeVoice);
    442       if TelWorkVoice <> '' then Add('TEL;WORK;VOICE:' + TelWorkVoice);
    443       if TelVoice <> '' then Add('TEL;VOICE:' + TelVoice);
    444       if TelMain <> '' then Add('TEL;MAIN:' + TelMain);
    445       if Note <> '' then Add('NOTE:' + Note);
    446       if AdrHome <> '' then Add('ADR;HOME:' + AdrHome);
    447       if EmailHome <> '' then Add('EMAIL;HOME:' + EmailHome);
    448       if NickName <> '' then Add('X-NICKNAME:' + NickName);
    449       if EmailInternet <> '' then Add('EMAIL;INTERNET:' + EmailInternet);
    450       if XJabber <> '' then Add('X-JABBER:' + XJabber);
    451       if Role <> '' then Add('TITLE:' + Role);
    452       if Categories <> '' then Add('CATEGORIES:' + Categories);
    453       if Organization <> '' then Add('ORG:' + Organization);
    454       if (HomeAddressCity <> '') or (HomeAddressStreet <> '') or
    455         (HomeAddressCountry <> '') then Add('ADR;HOME:;;' + HomeAddressStreet + ';' + HomeAddressCity + ';;;' + HomeAddressCountry);
    456       if Photo <> '' then begin
    457         PhotoBase64 := EncodeStringBase64(Photo);
    458 
    459         Line := Copy(PhotoBase64, 1, 73 - Length('PHOTO;ENCODING=BASE64;JPEG:'));
    460         System.Delete(PhotoBase64, 1, Length(Line));
    461         Add('PHOTO;ENCODING=BASE64;JPEG:' + Line);
    462         while PhotoBase64 <> '' do begin
    463           Line := Copy(PhotoBase64, 1, 73);
    464           System.Delete(PhotoBase64, 1, Length(Line));
    465           Add(' ' + Line);
     478      for J := 0 to Properties.Count - 1 do
     479      with Properties[J] do begin
     480        Value := Values.DelimitedText;
     481        if Pos(LineEnding, Value) > 0 then begin
     482          NameText := Name;
     483          if Attributes.Count > 0 then
     484            NameText := NameText + ';' + Attributes.DelimitedText;
     485          Add(NameText + ':' + GetNext(Value, LineEnding));
     486          while Pos(LineEnding, Value) > 0 do begin
     487            Add(' ' + GetNext(Value, LineEnding));
     488          end;
     489          Add(' ' + GetNext(Value, LineEnding));
     490          Add('');
     491        end else begin
     492          NameText := Name;
     493          if Attributes.Count > 0 then
     494            NameText := NameText + ';' + Attributes.DelimitedText;
     495          Add(NameText + ':' + Value);
    466496        end;
    467         Add('');
    468497      end;
    469498      Add('END:VCARD');
    … …  
    479508  Lines: TStringList;
    480509  Line: string;
     510  Value: string;
    481511  I: Integer;
    482512  NewRecord: TContact;
    483   Command: string;
     513  NewProperty: TContactProperty;
    484514  CommandPart: string;
    485   Charset: string;
    486   Encoding: string;
    487   Language: string;
    488   CommandItems: TStringList;
     515  Names: string;
    489516begin
    490517  inherited;
    … …  
    494521  Lines.LoadFromFile(FileName);
    495522  try
    496     CommandItems := TStringList.Create;
    497     CommandItems.Delimiter := ';';
    498523    I := 0;
    499524    while I < Lines.Count do begin
    500525      Line := Lines[I];
     526      if Line = '' then
     527      else
    501528      if Line = 'BEGIN:VCARD' then begin
    502529        NewRecord := TContact.Create;
    … …  
    511538      if Pos(':', Line) > 0 then begin
    512539        CommandPart := GetNext(Line, ':');
    513         CommandItems.DelimitedText := CommandPart;
    514         if CommandItems.IndexOfName('CHARSET') >= 0 then begin
    515           Charset := CommandItems.Values['CHARSET'];
    516           CommandItems.Delete(CommandItems.IndexOfName('CHARSET'));
    517         end
    518         else if CommandItems.IndexOfName('ENCODING') >= 0 then begin
    519           Encoding := CommandItems.Values['ENCODING'];
    520           CommandItems.Delete(CommandItems.IndexOfName('ENCODING'));
    521         end
    522         else if CommandItems.IndexOfName('LANGUAGE') >= 0 then begin
    523           Language := CommandItems.Values['LANGUAGE'];
    524           CommandItems.Delete(CommandItems.IndexOfName('LANGUAGE'));
    525         end;
    526         Command := CommandItems.DelimitedText;
    527 
    528540        if Assigned(NewRecord) then begin
    529           if Command = 'FN' then NewRecord.FullName := Line
    530           else if Command = 'N' then begin
    531             NewRecord.LastName := GetNext(Line, ';');
    532             NewRecord.FirstName := GetNext(Line, ';');
    533             NewRecord.MiddleName := GetNext(Line, ';');
    534             NewRecord.TitleBefore := GetNext(Line, ';');
    535             NewRecord.TitleAfter := GetNext(Line, ';');
    536           end
    537           else if Command = 'VERSION' then NewRecord.Version := Line
    538           else if Command = 'TEL;PREF;CELL' then NewRecord.TelPrefCell := Line
    539           else if Command = 'TEL;CELL' then NewRecord.TelCell := Line
    540           else if Command = 'TEL;HOME' then NewRecord.TelHome := Line
    541           else if Command = 'TEL;HOME2' then NewRecord.TelHome2 := Line
    542           else if Command = 'TEL;WORK' then NewRecord.TelWork := Line
    543           else if Command = 'TEL;VOIP' then NewRecord.TelVoip := Line
    544           else if Command = 'TEL;PREF;WORK;VOICE' then NewRecord.TelPrefWorkVoice := Line
    545           else if Command = 'TEL;PREF;HOME;VOICE' then NewRecord.TelPrefHOMEVoice := Line
    546           else if Command = 'TEL;HOME;VOICE' then NewRecord.TelHomeVoice := Line
    547           else if Command = 'TEL;WORK;VOICE' then NewRecord.TelWorkVoice := Line
    548           else if Command = 'TEL;VOICE' then NewRecord.TelVoice := Line
    549           else if Command = 'TEL;MAIN' then NewRecord.TelMain := Line
    550           else if Command = 'ADR;HOME' then NewRecord.AdrHome := Line
    551           else if Command = 'X-NICKNAME' then NewRecord.NickName := Line
    552           else if Command = 'EMAIL;HOME' then NewRecord.EmailHome := Line
    553           else if Command = 'EMAIL;INTERNET' then NewRecord.EmailInternet := Line
    554           else if Command = 'NOTE' then NewRecord.Note := Line
    555           else if Command = 'ORG' then NewRecord.Organization := Line
    556           else if Command = 'X-JABBER' then NewRecord.XJabber := Line
    557           else if Command = 'TITLE' then NewRecord.Role := Line
    558           else if Command = 'X-TIMES_CONTACTED' then NewRecord.XTimesContacted := Line
    559           else if Command = 'X-LAST_TIME_CONTACTED' then NewRecord.XLastTimeContacted := Line
    560           else if Command = 'PHOTO;JPEG' then begin
    561             NewRecord.Photo := Trim(Line);
    562             repeat
    563               Inc(I);
    564               Line := Trim(Lines[I]);
    565               if Line <> '' then NewRecord.Photo := NewRecord.Photo + Line;
    566             until Line = '';
    567             NewRecord.Photo := DecodeStringBase64(NewRecord.Photo);
    568           end
    569           else Error(Format(SUnknownCommand, [Command]), I + 1);
     541          Names := CommandPart;
     542          Value := Line;
     543          while True do begin
     544            Inc(I);
     545            if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
     546              Value := Value + Trim(Lines[I]);
     547            end else begin
     548              Dec(I);
     549              Break;
     550            end;
     551          end;
     552          NewProperty := NewRecord.Properties.GetByName(Names);
     553          if not Assigned(NewProperty) then begin
     554            NewProperty := TContactProperty.Create;
     555            NewRecord.Properties.Add(NewProperty);
     556          end;
     557          NewProperty.Attributes.DelimitedText := Names;
     558          if NewProperty.Attributes.Count > 0 then begin
     559            NewProperty.Name := NewProperty.Attributes[0];
     560            NewProperty.Attributes.Delete(0);
     561          end;
     562          NewProperty.Values.DelimitedText := Value;
     563          NewProperty.EvaluateAttributes;
    570564        end else Error(SFoundPropertiesBeforeBlockStart, I + 1);
    571565      end;
    572566      Inc(I);
    573567    end;
    574     CommandItems.Free;
    575568  finally
    576569    Lines.Free;

  • trunk/UCore.pas

    r30 r31  
    364364      Result.Loaded := TempFile.Contacts.Count;
    365365      for I := 0 to TempFile.Contacts.Count - 1 do begin
    366         NewContact := TContactsFile(DataFile).Contacts.Search(TContact(TempFile.Contacts[I]).FullName);
     366        NewContact := TContactsFile(DataFile).Contacts.Search(TContact(TempFile.Contacts[I]).Fields[cfFullName]);
    367367        if not Assigned(NewContact) then begin
    368368          NewContact := TContact.Create;

  • trunk/vCardStudio.lpi

    r30 r31  
    167167        <IsPartOfProject Value="True"/>
    168168        <ComponentName Value="FormError"/>
     169        <HasResources Value="True"/>
    169170        <ResourceBaseClass Value="Form"/>
    170171      </Unit10>
Note: See TracChangeset for help on using the changeset viewer.