Changeset 82 for trunk/UContact.pas


Ignore:
Timestamp:
Dec 21, 2021, 5:16:41 PM (2 years ago)
Author:
chronos
Message:
  • Fixed: Settings option to load previously opened file wasn't working for disabled state.
  • Fixed: Disable Find action if no file is opened.
  • Modified: Move fields initialization method to TContact class and made it static so it is initialized only once.
  • Added: Allow to set default vCard version in settings dialog.
  • Modified: Add GTK2 theming support to snap package.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UContact.pas

    r77 r82  
    106106
    107107  TContactProperties = class(TFPGObjectList<TContactProperty>)
     108    function AddNew(Name, Value: string): TContactProperty;
    108109    procedure Assign(Source: TContactProperties);
    109110    procedure AssignToList(List: TFPGObjectList<TObject>);
    … …  
    121122    FModified: Boolean;
    122123    FOnModify: TNotifyEvent;
     124    class var FFields: TContactFields;
    123125    function GetField(Index: TContactFieldIndex): string;
    124126    procedure SetField(Index: TContactFieldIndex; AValue: string);
    … …  
    127129  public
    128130    Properties: TContactProperties;
    129     Parent: TContactsFile;
     131    ContactsFile: TContactsFile;
     132    class function GetFields: TContactFields;
    130133    function HasField(FieldIndex: TContactFieldIndex): Boolean;
    131134    function FullNameToFileName: string;
    … …  
    136139    constructor Create;
    137140    destructor Destroy; override;
     141    class destructor Destroy;
    138142    procedure SaveToStrings(Output: TStrings);
    139143    function LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
    … …  
    167171  private
    168172    FOnError: TErrorEvent;
    169     procedure InitFields;
    170173    procedure Error(Text: string; Line: Integer);
    171174    function NewItem(Key, Value: string): string;
    172175  public
    173     Fields: TContactFields;
    174176    Contacts: TContacts;
    175177    function GetFileName: string; override;
    … …  
    430432{ TContactProperties }
    431433
     434function TContactProperties.AddNew(Name, Value: string): TContactProperty;
     435begin
     436  Result := TContactProperty.Create;
     437  Result.Name := Name;
     438  Result.Value := Value;
     439  Add(Result);
     440end;
     441
    432442procedure TContactProperties.Assign(Source: TContactProperties);
    433443var
    … …  
    643653  for I := 0 to Count - 1 do begin
    644654    Items[I].Assign(Source.Items[I]);
    645     Items[I].Parent := ContactsFile;
     655    Items[I].ContactsFile := ContactsFile;
    646656  end;
    647657end;
    … …  
    655665    NewContact := TContact.Create;
    656666    NewContact.Assign(Contacts[I]);
    657     NewContact.Parent := ContactsFile;
     667    NewContact.ContactsFile := ContactsFile;
    658668    Add(NewContact);
    659669  end;
    … …  
    668678    NewContact := TContact.Create;
    669679    NewContact.Assign(Contacts[I]);
    670     NewContact.Parent := ContactsFile;
     680    NewContact.ContactsFile := ContactsFile;
    671681    Insert(Index, NewContact);
    672682    Inc(Index);
    … …  
    687697begin
    688698  Result := TContact.Create;
    689   Result.Parent := ContactsFile;
     699  Result.ContactsFile := ContactsFile;
    690700  Add(Result);
    691701end;
    … …  
    723733    NewContact := TContact.Create;
    724734    NewContact.Assign(Contact);
    725     NewContact.Parent := ContactsFile;
     735    NewContact.ContactsFile := ContactsFile;
    726736    Add(NewContact);
    727737  end;
    … …  
    813823{ TContact }
    814824
    815 function TContact.GetField(Index: TContactFieldIndex): string;
    816 var
    817   Prop: TContactProperty;
    818   Field: TContactField;
    819 begin
    820   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    821   Field := Parent.Fields.GetByIndex(Index);
    822   if Assigned(Field) then begin
    823     Prop := GetProperty(Field);
    824     if Assigned(Prop) then begin
    825       Field := Parent.Fields.GetByIndex(Index);
    826       if Field.ValueIndex <> -1 then begin
    827         Result := DecodeEscaped(Prop.ValueItem[Field.ValueIndex])
    828       end else Result := Prop.Value;
    829     end else Result := '';
    830   end else raise Exception.Create(SFieldIndexNotDefined);
    831 end;
    832 
    833 procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
    834 var
    835   Prop: TContactProperty;
    836   Field: TContactField;
    837   I: Integer;
    838 begin
    839   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    840   Field := Parent.Fields.GetByIndex(Index);
    841   if Assigned(Field) then begin
    842     Prop := GetProperty(Field);
    843     if (not Assigned(Prop)) and (AValue <> '') then begin
    844       Prop := TContactProperty.Create;
    845       Prop.Name := Field.SysName;
    846       for I := 0 to Length(Field.Groups) - 1 do
    847         Prop.Attributes.Add(Field.Groups[I]);
    848       Properties.Add(Prop);
    849     end;
    850     if Assigned(Prop) then begin
    851       if Field.ValueIndex <> -1 then begin
    852         Prop.ValueItem[Field.ValueIndex] := EncodeEscaped(AValue);
    853       end else Prop.Value := AValue;
    854 
    855       // Remove if empty
    856       if Prop.Value = '' then begin
    857         Properties.Remove(Prop);
    858       end;
    859     end;
    860     Modified := True;
    861   end else raise Exception.Create(SFieldIndexNotDefined);
    862 end;
    863 
    864 procedure TContact.SetModified(AValue: Boolean);
    865 begin
    866   if FModified = AValue then Exit;
    867   FModified := AValue;
    868   DoOnModify;
    869 end;
    870 
    871 procedure TContact.DoOnModify;
    872 begin
    873   if Assigned(FOnModify) then FOnModify(Self);
    874 end;
    875 
    876 function TContact.HasField(FieldIndex: TContactFieldIndex): Boolean;
    877 var
    878   Field: TContactField;
    879 begin
    880   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    881   Field := Parent.Fields.GetByIndex(FieldIndex);
    882   if Assigned(Field) then begin
    883     Result := Assigned(GetProperty(Field));
    884   end else raise Exception.Create(SFieldIndexNotDefined);
    885 end;
    886 
    887 function TContact.FullNameToFileName: string;
    888 var
    889   I: Integer;
    890 begin
    891   Result := Fields[cfFullName];
    892   for I := 1 to Length(Result) do begin
    893     if Result[I] in [':', '/', '\', '.', '"', '*', '|', '?', '<', '>'] then
    894       Result[I] := '_';
    895   end;
    896 end;
    897 
    898 function TContact.GetProperty(Field: TContactField): TContactProperty;
    899 var
    900   I: Integer;
    901 begin
    902   Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
    903   I := 0;
    904   while (not Assigned(Result)) and (I < Field.Alternatives.Count) do begin
    905     Result := Properties.GetByNameGroups(Field.Alternatives[I].SysName,
    906       Field.Alternatives[I].Groups, Field.Alternatives[I].NoGroups);
    907     if Assigned(Result) then Break;
    908     Inc(I);
    909   end;
    910 end;
    911 
    912 function TContact.GetProperty(FieldIndex: TContactFieldIndex): TContactProperty;
    913 var
    914   Field: TContactField;
    915 begin
    916   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    917   Field := Parent.Fields.GetByIndex(FieldIndex);
    918   if Assigned(Field) then begin
    919     Result := GetProperty(Field);
    920   end else Result := nil;
    921 end;
    922 
    923 procedure TContact.Assign(Source: TContact);
    924 begin
    925   Properties.Assign(Source.Properties);
    926   FModified := Source.FModified;
    927 end;
    928 
    929 function TContact.UpdateFrom(Source: TContact): Boolean;
    930 var
    931   I: Integer;
    932 begin
    933   if not Assigned(Parent) then raise Exception.Create(SContactHasNoParent);
    934   Result := False;
    935   for I := 0 to Parent.Fields.Count - 1 do begin
    936     if (Source.Fields[Parent.Fields[I].Index] <> '') and
    937       (Source.Fields[Parent.Fields[I].Index] <>
    938       Fields[Parent.Fields[I].Index]) then begin
    939         Result := True;
    940         Fields[Parent.Fields[I].Index] := Source.Fields[Parent.Fields[I].Index];
    941       end;
    942   end;
    943 end;
    944 
    945 constructor TContact.Create;
    946 begin
    947   Properties := TContactProperties.Create;
    948 end;
    949 
    950 destructor TContact.Destroy;
    951 begin
    952   FreeAndNil(Properties);
    953   inherited;
    954 end;
    955 
    956 procedure TContact.SaveToStrings(Output: TStrings);
    957 var
    958   I: Integer;
    959   NameText: string;
    960   Value2: string;
    961   LineIndex: Integer;
    962   OutText: string;
    963   LinePrefix: string;
    964   CutLength: Integer;
    965 const
    966   MaxLineLength = 73;
    967 begin
    968     with Output do begin
    969       Add(VCardBegin);
    970       for I := 0 to Properties.Count - 1 do
    971       with Properties[I] do begin
    972         NameText := Name;
    973         if Attributes.Count > 0 then
    974           NameText := NameText + ';' + Attributes.DelimitedText;
    975         if Encoding <> '' then begin
    976           Value2 := GetEncodedValue;
    977           NameText := NameText + ';ENCODING=' + Encoding;
    978         end else Value2 := Value;
    979         if Pos(LineEnding, Value2) > 0 then begin
    980           Add(NameText + ':' + GetNext(Value2, LineEnding));
    981           while Pos(LineEnding, Value2) > 0 do begin
    982             Add(' ' + GetNext(Value2, LineEnding));
    983           end;
    984           Add(' ' + GetNext(Value2, LineEnding));
    985           Add('');
    986         end else begin
    987           OutText := NameText + ':' + Value2;
    988           LineIndex := 0;
    989           LinePrefix := '';
    990           while True do begin
    991             if Length(OutText) > MaxLineLength then begin
    992               CutLength := MaxLineLength;
    993               if Encoding = 'QUOTED-PRINTABLE' then begin
    994                 // Do not cut encoded items
    995                 if ((CutLength - 2) >= 1) and (OutText[CutLength - 2] = '=') then
    996                   Dec(CutLength, 2)
    997                 else if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = '=') then
    998                   Dec(CutLength, 1);
    999               end;
    1000               Add(LinePrefix + Copy(OutText, 1, CutLength));
    1001               LinePrefix := ' ';
    1002               System.Delete(OutText, 1, CutLength);
    1003               Inc(LineIndex);
    1004               Continue;
    1005             end else begin
    1006               Add(LinePrefix + OutText);
    1007               Break;
    1008             end;
    1009           end;
    1010           if LinePrefix <> '' then Add('');
    1011         end;
    1012       end;
    1013       Add(VCardEnd);
    1014     end;
    1015 end;
    1016 
    1017 function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
    1018 type
    1019   TParseState = (psNone, psInside, psFinished);
    1020 var
    1021   ParseState: TParseState;
    1022   Line: string;
    1023   Value: string;
    1024   I: Integer;
    1025   NewProperty: TContactProperty;
    1026   CommandPart: string;
    1027   Names: string;
    1028 begin
    1029   ParseState := psNone;
    1030   I := StartLine;
    1031   while I < Lines.Count do begin
    1032     Line := Trim(Lines[I]);
    1033     if Line = '' then begin
    1034       // Skip empty lines
    1035     end else
    1036     if ParseState = psNone then begin
    1037       if Line = VCardBegin then begin
    1038         ParseState := psInside;
    1039       end else begin
    1040         Parent.Error(SExpectedVCardBegin, I + 1);
    1041         I := -1;
    1042         Break;
    1043       end;
    1044     end else
    1045     if ParseState = psInside then begin
    1046       if Line = VCardEnd then begin
    1047         ParseState := psFinished;
    1048         Inc(I);
    1049         Break;
    1050       end else
    1051       if Pos(':', Line) > 0 then begin
    1052         CommandPart := GetNext(Line, ':');
    1053         Names := CommandPart;
    1054         Value := Line;
    1055         while True do begin
    1056           Inc(I);
    1057           if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
    1058             Value := Value + Trim(Lines[I]);
    1059           end else
    1060           if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
    1061             (Lines[I][1] = '=') then begin
    1062             Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
    1063           end else begin
    1064             Dec(I);
    1065             Break;
    1066           end;
    1067         end;
    1068         NewProperty := Properties.GetByName(Names);
    1069         if not Assigned(NewProperty) then begin
    1070           NewProperty := TContactProperty.Create;
    1071           Properties.Add(NewProperty);
    1072         end;
    1073         NewProperty.Attributes.DelimitedText := Names;
    1074         if NewProperty.Attributes.Count > 0 then begin
    1075           NewProperty.Name := NewProperty.Attributes[0];
    1076           NewProperty.Attributes.Delete(0);
    1077         end;
    1078         NewProperty.Value := Value;
    1079         NewProperty.EvaluateAttributes;
    1080       end else begin
    1081         Parent.Error(SExpectedProperty, I + 1);
    1082         I := -1;
    1083         Break;
    1084       end;
    1085     end;
    1086     Inc(I);
    1087   end;
    1088   Result := I;
    1089 end;
    1090 
    1091 procedure TContact.SaveToFile(FileName: string);
    1092 var
    1093   Lines: TStringList;
    1094 begin
    1095   Lines := TStringList.Create;
    1096   try
    1097     SaveToStrings(Lines);
    1098     Lines.SaveToFile(FileName);
    1099   finally
    1100     Lines.Free;
    1101   end;
    1102 end;
    1103 
    1104 procedure TContact.LoadFromFile(FileName: string);
    1105 var
    1106   Lines: TStringList;
    1107 begin
    1108   Lines := TStringList.Create;
    1109   try
    1110     Lines.LoadFromFile(FileName);
    1111     {$IF FPC_FULLVERSION>=30200}
    1112     if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
    1113       Lines.LoadFromFile(FileName, TEncoding.Unicode);
    1114       if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
    1115         Lines.LoadFromFile(FileName, TEncoding.BigEndianUnicode);
    1116       end;
    1117     end;
    1118     {$ENDIF}
    1119     LoadFromStrings(Lines);
    1120   finally
    1121     Lines.Free;
    1122   end;
    1123 end;
    1124 
    1125 { TContactsFile }
    1126 
    1127 procedure TContactsFile.InitFields;
    1128 begin
    1129   with Fields do begin
     825class function TContact.GetFields: TContactFields;
     826begin
     827  if not Assigned(FFields) then begin
     828    FFields := TContactFields.Create;
     829    with FFields do begin
    1130830    AddNew('VERSION', [], [], SVersion, cfVersion, dtString);
    1131831    AddNew('N', [], [], SLastName, cfLastName, dtString, 0);
    … …  
    1230930    with AddNew('X-MYSPACE', [], [], SMySpace, cfMySpace, dtString) do
    1231931      AddAlternative('X-SOCIALPROFILE', ['MYSPACE'], []);
    1232   end;
    1233 end;
     932    end;
     933  end;
     934  Result := FFields;
     935end;
     936
     937function TContact.GetField(Index: TContactFieldIndex): string;
     938var
     939  Prop: TContactProperty;
     940  Field: TContactField;
     941begin
     942  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     943  Field := GetFields.GetByIndex(Index);
     944  if Assigned(Field) then begin
     945    Prop := GetProperty(Field);
     946    if Assigned(Prop) then begin
     947      Field := GetFields.GetByIndex(Index);
     948      if Field.ValueIndex <> -1 then begin
     949        Result := DecodeEscaped(Prop.ValueItem[Field.ValueIndex])
     950      end else Result := Prop.Value;
     951    end else Result := '';
     952  end else raise Exception.Create(SFieldIndexNotDefined);
     953end;
     954
     955procedure TContact.SetField(Index: TContactFieldIndex; AValue: string);
     956var
     957  Prop: TContactProperty;
     958  Field: TContactField;
     959  I: Integer;
     960begin
     961  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     962  Field := GetFields.GetByIndex(Index);
     963  if Assigned(Field) then begin
     964    Prop := GetProperty(Field);
     965    if (not Assigned(Prop)) and (AValue <> '') then begin
     966      Prop := TContactProperty.Create;
     967      Prop.Name := Field.SysName;
     968      for I := 0 to Length(Field.Groups) - 1 do
     969        Prop.Attributes.Add(Field.Groups[I]);
     970      Properties.Add(Prop);
     971    end;
     972    if Assigned(Prop) then begin
     973      if Field.ValueIndex <> -1 then begin
     974        Prop.ValueItem[Field.ValueIndex] := EncodeEscaped(AValue);
     975      end else Prop.Value := AValue;
     976
     977      // Remove if empty
     978      if Prop.Value = '' then begin
     979        Properties.Remove(Prop);
     980      end;
     981    end;
     982    Modified := True;
     983  end else raise Exception.Create(SFieldIndexNotDefined);
     984end;
     985
     986procedure TContact.SetModified(AValue: Boolean);
     987begin
     988  if FModified = AValue then Exit;
     989  FModified := AValue;
     990  DoOnModify;
     991end;
     992
     993procedure TContact.DoOnModify;
     994begin
     995  if Assigned(FOnModify) then FOnModify(Self);
     996end;
     997
     998function TContact.HasField(FieldIndex: TContactFieldIndex): Boolean;
     999var
     1000  Field: TContactField;
     1001begin
     1002  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     1003  Field := GetFields.GetByIndex(FieldIndex);
     1004  if Assigned(Field) then begin
     1005    Result := Assigned(GetProperty(Field));
     1006  end else raise Exception.Create(SFieldIndexNotDefined);
     1007end;
     1008
     1009function TContact.FullNameToFileName: string;
     1010var
     1011  I: Integer;
     1012begin
     1013  Result := Fields[cfFullName];
     1014  for I := 1 to Length(Result) do begin
     1015    if Result[I] in [':', '/', '\', '.', '"', '*', '|', '?', '<', '>'] then
     1016      Result[I] := '_';
     1017  end;
     1018end;
     1019
     1020function TContact.GetProperty(Field: TContactField): TContactProperty;
     1021var
     1022  I: Integer;
     1023begin
     1024  Result := Properties.GetByNameGroups(Field.SysName, Field.Groups, Field.NoGroups);
     1025  I := 0;
     1026  while (not Assigned(Result)) and (I < Field.Alternatives.Count) do begin
     1027    Result := Properties.GetByNameGroups(Field.Alternatives[I].SysName,
     1028      Field.Alternatives[I].Groups, Field.Alternatives[I].NoGroups);
     1029    if Assigned(Result) then Break;
     1030    Inc(I);
     1031  end;
     1032end;
     1033
     1034function TContact.GetProperty(FieldIndex: TContactFieldIndex): TContactProperty;
     1035var
     1036  Field: TContactField;
     1037begin
     1038  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     1039  Field := GetFields.GetByIndex(FieldIndex);
     1040  if Assigned(Field) then begin
     1041    Result := GetProperty(Field);
     1042  end else Result := nil;
     1043end;
     1044
     1045procedure TContact.Assign(Source: TContact);
     1046begin
     1047  Properties.Assign(Source.Properties);
     1048  FModified := Source.FModified;
     1049end;
     1050
     1051function TContact.UpdateFrom(Source: TContact): Boolean;
     1052var
     1053  I: Integer;
     1054begin
     1055  if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     1056  Result := False;
     1057  for I := 0 to GetFields.Count - 1 do begin
     1058    if (Source.Fields[GetFields[I].Index] <> '') and
     1059      (Source.Fields[GetFields[I].Index] <>
     1060      Fields[GetFields[I].Index]) then begin
     1061        Result := True;
     1062        Fields[GetFields[I].Index] := Source.Fields[GetFields[I].Index];
     1063      end;
     1064  end;
     1065end;
     1066
     1067constructor TContact.Create;
     1068begin
     1069  Properties := TContactProperties.Create;
     1070end;
     1071
     1072destructor TContact.Destroy;
     1073begin
     1074  FreeAndNil(Properties);
     1075  inherited;
     1076end;
     1077
     1078class destructor TContact.Destroy;
     1079begin
     1080  FreeAndNil(FFields);
     1081end;
     1082
     1083procedure TContact.SaveToStrings(Output: TStrings);
     1084var
     1085  I: Integer;
     1086  NameText: string;
     1087  Value2: string;
     1088  LineIndex: Integer;
     1089  OutText: string;
     1090  LinePrefix: string;
     1091  CutLength: Integer;
     1092const
     1093  MaxLineLength = 73;
     1094begin
     1095    with Output do begin
     1096      Add(VCardBegin);
     1097      for I := 0 to Properties.Count - 1 do
     1098      with Properties[I] do begin
     1099        NameText := Name;
     1100        if Attributes.Count > 0 then
     1101          NameText := NameText + ';' + Attributes.DelimitedText;
     1102        if Encoding <> '' then begin
     1103          Value2 := GetEncodedValue;
     1104          NameText := NameText + ';ENCODING=' + Encoding;
     1105        end else Value2 := Value;
     1106        if Pos(LineEnding, Value2) > 0 then begin
     1107          Add(NameText + ':' + GetNext(Value2, LineEnding));
     1108          while Pos(LineEnding, Value2) > 0 do begin
     1109            Add(' ' + GetNext(Value2, LineEnding));
     1110          end;
     1111          Add(' ' + GetNext(Value2, LineEnding));
     1112          Add('');
     1113        end else begin
     1114          OutText := NameText + ':' + Value2;
     1115          LineIndex := 0;
     1116          LinePrefix := '';
     1117          while True do begin
     1118            if Length(OutText) > MaxLineLength then begin
     1119              CutLength := MaxLineLength;
     1120              if Encoding = 'QUOTED-PRINTABLE' then begin
     1121                // Do not cut encoded items
     1122                if ((CutLength - 2) >= 1) and (OutText[CutLength - 2] = '=') then
     1123                  Dec(CutLength, 2)
     1124                else if ((CutLength - 1) >= 1) and (OutText[CutLength - 1] = '=') then
     1125                  Dec(CutLength, 1);
     1126              end;
     1127              Add(LinePrefix + Copy(OutText, 1, CutLength));
     1128              LinePrefix := ' ';
     1129              System.Delete(OutText, 1, CutLength);
     1130              Inc(LineIndex);
     1131              Continue;
     1132            end else begin
     1133              Add(LinePrefix + OutText);
     1134              Break;
     1135            end;
     1136          end;
     1137          if LinePrefix <> '' then Add('');
     1138        end;
     1139      end;
     1140      Add(VCardEnd);
     1141    end;
     1142end;
     1143
     1144function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
     1145type
     1146  TParseState = (psNone, psInside, psFinished);
     1147var
     1148  ParseState: TParseState;
     1149  Line: string;
     1150  Value: string;
     1151  I: Integer;
     1152  NewProperty: TContactProperty;
     1153  CommandPart: string;
     1154  Names: string;
     1155begin
     1156  ParseState := psNone;
     1157  I := StartLine;
     1158  while I < Lines.Count do begin
     1159    Line := Trim(Lines[I]);
     1160    if Line = '' then begin
     1161      // Skip empty lines
     1162    end else
     1163    if ParseState = psNone then begin
     1164      if Line = VCardBegin then begin
     1165        ParseState := psInside;
     1166      end else begin
     1167        ContactsFile.Error(SExpectedVCardBegin, I + 1);
     1168        I := -1;
     1169        Break;
     1170      end;
     1171    end else
     1172    if ParseState = psInside then begin
     1173      if Line = VCardEnd then begin
     1174        ParseState := psFinished;
     1175        Inc(I);
     1176        Break;
     1177      end else
     1178      if Pos(':', Line) > 0 then begin
     1179        CommandPart := GetNext(Line, ':');
     1180        Names := CommandPart;
     1181        Value := Line;
     1182        while True do begin
     1183          Inc(I);
     1184          if (Length(Lines[I]) > 0) and (Lines[I][1] = ' ') then begin
     1185            Value := Value + Trim(Lines[I]);
     1186          end else
     1187          if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
     1188            (Lines[I][1] = '=') then begin
     1189            Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
     1190          end else begin
     1191            Dec(I);
     1192            Break;
     1193          end;
     1194        end;
     1195        NewProperty := Properties.GetByName(Names);
     1196        if not Assigned(NewProperty) then begin
     1197          NewProperty := TContactProperty.Create;
     1198          Properties.Add(NewProperty);
     1199        end;
     1200        NewProperty.Attributes.DelimitedText := Names;
     1201        if NewProperty.Attributes.Count > 0 then begin
     1202          NewProperty.Name := NewProperty.Attributes[0];
     1203          NewProperty.Attributes.Delete(0);
     1204        end;
     1205        NewProperty.Value := Value;
     1206        NewProperty.EvaluateAttributes;
     1207      end else begin
     1208        ContactsFile.Error(SExpectedProperty, I + 1);
     1209        I := -1;
     1210        Break;
     1211      end;
     1212    end;
     1213    Inc(I);
     1214  end;
     1215  Result := I;
     1216end;
     1217
     1218procedure TContact.SaveToFile(FileName: string);
     1219var
     1220  Lines: TStringList;
     1221begin
     1222  Lines := TStringList.Create;
     1223  try
     1224    SaveToStrings(Lines);
     1225    Lines.SaveToFile(FileName);
     1226  finally
     1227    Lines.Free;
     1228  end;
     1229end;
     1230
     1231procedure TContact.LoadFromFile(FileName: string);
     1232var
     1233  Lines: TStringList;
     1234begin
     1235  Lines := TStringList.Create;
     1236  try
     1237    Lines.LoadFromFile(FileName);
     1238    {$IF FPC_FULLVERSION>=30200}
     1239    if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
     1240      Lines.LoadFromFile(FileName, TEncoding.Unicode);
     1241      if (Length(Lines.Text) > 0) and (Pos(VCardBegin, Lines.Text) = 0) then begin
     1242        Lines.LoadFromFile(FileName, TEncoding.BigEndianUnicode);
     1243      end;
     1244    end;
     1245    {$ENDIF}
     1246    LoadFromStrings(Lines);
     1247  finally
     1248    Lines.Free;
     1249  end;
     1250end;
     1251
     1252{ TContactsFile }
    12341253
    12351254procedure TContactsFile.Error(Text: string; Line: Integer);
    … …  
    12721291  while I < Lines.Count do begin
    12731292    Contact := TContact.Create;
    1274     Contact.Parent := Self;
     1293    Contact.ContactsFile := Self;
    12751294    NewI := Contact.LoadFromStrings(Lines, I);
    12761295    if NewI <= Lines.Count then begin
    … …  
    13391358  Contacts := TContacts.Create;
    13401359  Contacts.ContactsFile := Self;
    1341   Fields := TContactFields.Create;
    1342   InitFields;
    13431360end;
    13441361
    13451362destructor TContactsFile.Destroy;
    13461363begin
    1347   FreeAndNil(Fields);
    13481364  FreeAndNil(Contacts);
    13491365  inherited;
Note: See TracChangeset for help on using the changeset viewer.