Changeset 30 for trunk/UContact.pas


Ignore:
Timestamp:
Nov 24, 2021, 8:42:24 PM (3 years ago)
Author:
chronos
Message:
  • Added: In case of loading errors show a list of found errors with line numbers.
  • Fixed: Check if property block started correctly.
  • Added: More standard properties.
  • Fixed: Improved alignment of fields in contact dialog.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/UContact.pas

    r29 r30  
    1111  TContactsFile = class;
    1212
    13   TStringEvent = procedure (Text: string) of object;
     13  TErrorEvent = procedure (Text: string; Line: Integer) of object;
    1414
    1515  TDataType = (dtString, dtInteger, dtDate, dtDateTime, dtImage);
    … …  
    1919    cfTelCell, cfTelHome, cfTelHome2, cfTelWork, cfTelVoip,
    2020    cfTelPrefWorkVoice, cfTelPrefHomeVoice, cfTelHomeVoice, cfTelWorkVoice,
     21    cfTelVoice, cfTelMain,
    2122    cfEmailHome, cfEmailInternet, cfNickName, cfNote, cfRole, cfTitle,
    2223    cfCategories, cfOrganization, cfAdrHome, cfHomeAddressStreet,
    … …  
    6364    TelHomeVoice: string;
    6465    TelWorkVoice: string;
     66    TelVoice: string;
     67    TelMain: string;
    6568    EmailHome: string;
    6669    EmailInternet: string;
    … …  
    97100  TContactsFile = class(TDataFile)
    98101  private
    99     FOnError: TStringEvent;
     102    FOnError: TErrorEvent;
    100103    function GetNext(var Text: string; Separator: string): string;
    101104    procedure InitFields;
     105    procedure Error(Text: string; Line: Integer);
    102106  public
    103107    Fields: TContactFields;
    … …  
    110114    constructor Create; override;
    111115    destructor Destroy; override;
    112     property OnError: TStringEvent read FOnError write FOnError;
     116    property OnError: TErrorEvent read FOnError write FOnError;
    113117  end;
    114118
    … …  
    119123  SVCardFile = 'vCard file';
    120124  SUnsupportedContactFieldsIndex = 'Unsupported contact field index';
     125  SUnknownCommand = 'Unknown command: %s';
     126  SFoundPropertiesBeforeBlockStart = 'Found properties before the start of block';
     127  SFoundBlockEndWithoutBlockStart = 'Found block end without block start';
    121128
    122129{ TContacts }
    … …  
    195202    cfTelHomeVoice: Result := TelHomeVoice;
    196203    cfTelWorkVoice: Result := TelWorkVoice;
     204    cfTelVoice: Result := TelVoice;
     205    cfTelMain: Result := TelMain;
    197206    cfEmailHome: Result := EmailHome;
    198207    cfEmailInternet: Result := EmailInternet;
    … …  
    234243    cfTelHomeVoice: TelHomeVoice := AValue;
    235244    cfTelWorkVoice: TelWorkVoice := AValue;
     245    cfTelVoice: TelVoice := AValue;
     246    cfTelMain: TelMain := AValue;
    236247    cfEmailHome: EmailHome := AValue;
    237248    cfEmailInternet: EmailInternet := AValue;
    … …  
    338349    AddNew('Tel Home Voice', cfTelHomeVoice, dtString);
    339350    AddNew('Tel Work Voice', cfTelWorkVoice, dtString);
     351    AddNew('Tel Voice', cfTelVoice, dtString);
     352    AddNew('Tel Main', cfTelMain, dtString);
    340353    AddNew('Email Home', cfEmailHome, dtString);
    341354    AddNew('Email Internet', cfEmailInternet, dtString);
    … …  
    355368    AddNew('Jabber', cfXJabber, dtString);
    356369  end;
     370end;
     371
     372procedure TContactsFile.Error(Text: string; Line: Integer);
     373begin
     374  if Assigned(FOnError) then FOnError(Text, Line);
    357375end;
    358376
    … …  
    423441      if TelHomeVoice <> '' then Add('TEL;HOME;VOICE:' + TelHomeVoice);
    424442      if TelWorkVoice <> '' then Add('TEL;WORK;VOICE:' + TelWorkVoice);
     443      if TelVoice <> '' then Add('TEL;VOICE:' + TelVoice);
     444      if TelMain <> '' then Add('TEL;MAIN:' + TelMain);
    425445      if Note <> '' then Add('NOTE:' + Note);
    426446      if AdrHome <> '' then Add('ADR;HOME:' + AdrHome);
    … …  
    469489begin
    470490  inherited;
     491  NewRecord := nil;
    471492  Contacts.Clear;
    472493  Lines := TStringList.Create;
    … …  
    483504      end else
    484505      if Line = 'END:VCARD' then begin
    485         Contacts.Add(NewRecord);
    486         NewRecord := nil;
     506        if Assigned(NewRecord) then begin
     507          Contacts.Add(NewRecord);
     508          NewRecord := nil;
     509        end else Error(SFoundBlockEndWithoutBlockStart, I + 1);
    487510      end else
    488511      if Pos(':', Line) > 0 then begin
    … …  
    503526        Command := CommandItems.DelimitedText;
    504527
    505         if Command = 'FN' then NewRecord.FullName := Line
    506         else if Command = 'N' then begin
    507           NewRecord.LastName := GetNext(Line, ';');
    508           NewRecord.FirstName := GetNext(Line, ';');
    509           NewRecord.MiddleName := GetNext(Line, ';');
    510           NewRecord.TitleBefore := GetNext(Line, ';');
    511           NewRecord.TitleAfter := GetNext(Line, ';');
    512         end
    513         else if Command = 'VERSION' then NewRecord.Version := Line
    514         else if Command = 'TEL;PREF;CELL' then NewRecord.TelPrefCell := Line
    515         else if Command = 'TEL;CELL' then NewRecord.TelCell := Line
    516         else if Command = 'TEL;HOME' then NewRecord.TelHome := Line
    517         else if Command = 'TEL;HOME2' then NewRecord.TelHome2 := Line
    518         else if Command = 'TEL;WORK' then NewRecord.TelWork := Line
    519         else if Command = 'TEL;VOIP' then NewRecord.TelVoip := Line
    520         else if Command = 'TEL;PREF;WORK;VOICE' then NewRecord.TelPrefWorkVoice := Line
    521         else if Command = 'TEL;PREF;HOME;VOICE' then NewRecord.TelPrefHOMEVoice := Line
    522         else if Command = 'TEL;HOME;VOICE' then NewRecord.TelHomeVoice := Line
    523         else if Command = 'TEL;WORK;VOICE' then NewRecord.TelWorkVoice := Line
    524         else if Command = 'ADR;HOME' then NewRecord.AdrHome := Line
    525         else if Command = 'X-NICKNAME' then NewRecord.NickName := Line
    526         else if Command = 'EMAIL;HOME' then NewRecord.EmailHome := Line
    527         else if Command = 'EMAIL;INTERNET' then NewRecord.EmailInternet := Line
    528         else if Command = 'NOTE' then NewRecord.Note := Line
    529         else if Command = 'ORG' then NewRecord.Organization := Line
    530         else if Command = 'X-JABBER' then NewRecord.XJabber := Line
    531         else if Command = 'TITLE' then NewRecord.Role := Line
    532         else if Command = 'X-TIMES_CONTACTED' then NewRecord.XTimesContacted := Line
    533         else if Command = 'X-LAST_TIME_CONTACTED' then NewRecord.XLastTimeContacted := Line
    534         else if Command = 'PHOTO;JPEG' then begin
    535           NewRecord.Photo := Trim(Line);
    536           repeat
    537             Inc(I);
    538             Line := Trim(Lines[I]);
    539             if Line <> '' then NewRecord.Photo := NewRecord.Photo + Line;
    540           until Line = '';
    541           NewRecord.Photo := DecodeStringBase64(NewRecord.Photo);
    542         end
    543         else if Assigned(FOnError) then FOnError('Unknown command: ' + Command);
     528        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);
     570        end else Error(SFoundPropertiesBeforeBlockStart, I + 1);
    544571      end;
    545572      Inc(I);
Note: See TracChangeset for help on using the changeset viewer.