uvcard.pas

来自「FMA is a free1 powerful phone editing to」· PAS 代码 · 共 1,151 行 · 第 1/3 页

unit uVCard; // do not localize

{
*******************************************************************************
* Descriptions: vCard object implementaton
* $Source: /cvsroot/fma/fma/uVCard.pas,v $
* $Locker:  $
*
* Todo:
*   - explore source for comments
*
* Change Log:
* $Log: uVCard.pas,v $
*
}

interface

uses Classes, TntClasses, SysUtils, TntSysUtils, Jpeg, RxGif, Graphics, TntGraphics;

type
  TPostalAddress = record
    Street: Widestring;
    City: Widestring;
    Region: Widestring;
    PostalCode: Widestring;
    Country: Widestring;
  end;

  TVCard = class(TObject)
  private
    { Private declarations }
    Grouping,PropertyName: Widestring;
    sl,mails: TStringList;
    FIsValid: boolean;
    function GetRaw: TStrings;
    procedure SetRaw(const ValueRaw: TStrings);
    procedure setProperty(Value: String);
    procedure checkPropertyParams(value:String);
    procedure RemoveSoftLineBrakes(var Value: TStringList);
    function DecodePropertyValue(const PParams, PValue: String): WideString;
    function GetLDIF: TStrings;
    function GetMail: TStrings;
    function GetDisplayName: WideString; 
    procedure SetMail(const Value: TStrings);
  public
    { Public declarations }
    Name: Widestring;
    TelWork: Widestring;
    TelHome: Widestring;
    TelFax: Widestring;
    TelCell: Widestring;
    TelOther: Widestring;
    URL: Widestring;
    Email: Widestring;
    Title: Widestring;
    Org: Widestring;
    LUID: Widestring;
    VType: Widestring;
    Version: Widestring;
    PhotoType: Integer;
    Photo: TGraphic;
    Surname: Widestring;
    DisplayName: Widestring;
    FullName: Widestring;
    Notes: Widestring;
    TelPref: string; // H = HOME, W = Work, F = Fax, M = CELL, O = Other
    UID: string;
    ModifiedDate: TDateTime;
    HomeAddress: TPostalAddress;
    WorkAddress: TPostalAddress;
    BDay: TDateTime;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function LoadFromLDIF(ldif: TStrings): boolean;
  published
    property Raw: TStrings read GetRaw write SetRaw;
    property MoreEmails: TStrings read GetMail write SetMail;
    property LDIF: TStrings read GetLDIF;
    property IsValidVCard: boolean read FIsValid;
  end;

var
    IsQP : boolean;     // QuotedPrintable
    IsUTF7 : boolean;   // UTF7
    IsUTF8 : boolean;   // UTF8

implementation

uses
  cUnicodeCodecs, uGlobal,
  Unit1, TntSystem, uVBase, uLogger, Variants;

{ TVCard }

procedure TVCard.Clear;
begin
    Name:='';
    Surname := '';
    TelPref := '';
    TelWork:='';
    TelHome:='';
    TelFax:='';
    TelCell:='';
    Email:='';
    TelOther:='';
    Title:='';
    Org:='';
    LUID:='';
    VType:='';
    Version:='';
    DisplayName := '';
    Grouping := '';
    PropertyName := '';
    UID := '';
    Notes := '';
    URL := '';
    HomeAddress.Street:='';
    HomeAddress.City:='';
    HomeAddress.Region:='';
    HomeAddress.PostalCode:='';
    HomeAddress.Country:='';
    WorkAddress.Street:='';
    WorkAddress.City:='';
    WorkAddress.Region:='';
    WorkAddress.PostalCode:='';
    WorkAddress.Country:='';
    ModifiedDate := EmptyDate;
    BDay := EmptyDate;
    PhotoType := 0;
    FreeAndNil(Photo);
    mails.Clear;
    sl.Clear;
    FIsValid := False;
end;

constructor TVCard.Create;
begin
  inherited;
  sl := TStringList.Create;
  mails := TStringList.Create;
end;

destructor TVCard.Destroy;
begin
  Clear;
  mails.Free;
  sl.Free;
  inherited;
end;

function TVCard.GetRaw: TStrings;
var
  strTemp : string;
  strN : WideString;
  i: integer;
  bY,bM,bD: word;
  //tz: TTimeZoneInformation;
  procedure slAddAdr(AName: string; Adr: TPostalAddress);
  var
    Str: WideString;
  begin
    with Adr do begin
      Str := Street + City + Region + PostalCode + Country;
      if Trim(Str) <> '' then begin
        strTemp :=  WideStringToUTF8(Str);
        if not Form1.FUseUTF8 or (strTemp = Str) then begin
          strTemp := Str2QP(Str);
          if strTemp = Str then
            sl.add('ADR;'+AName+':;;' + Street + ';' + City + ';' + Region + ';' + PostalCode + ';' + Country)
          else
            sl.Add('ADR;ENCODING=QUOTED-PRINTABLE;'+AName+':;;' + Str2QP(Street) + ';' + Str2QP(City) + ';' +
              Str2QP(Region) + ';' + Str2QP(PostalCode) + ';' + Str2QP(Country));
        end
        else
          sl.Add('ADR;CHARSET=UTF-8;'+AName+':;;' + WideStringToUTF8(Street) + ';' + WideStringToUTF8(City) + ';' +
            WideStringToUTF8(Region) + ';' + WideStringToUTF8(PostalCode) + ';' + WideStringToUTF8(Country));
      end;
    end;
  end;
begin
  sl.Clear;
  if VType = '' then
     sl.Add('BEGIN:VCARD')
  else
     sl.Add('BEGIN:' + VType);

  if Version = '' then
     sl.Add('VERSION:2.1')
  else
     sl.Add('VERSION:' + Version);

  { remove old name/surname from fullname }
  strN := FullName;
  i := Pos(';',strN);
  if i <> 0 then Delete(strN,1,i);
  i := Pos(';',strN);
  if i = 0 then i := Length(strN);
  Delete(strN,1,i);
  { add new ones to fullname }
  FullName := Surname + ';' + Name;
  if strN <> '' then
    FullName := FullName + ';' + strN;
  strN := FullName;

  strTemp := WideStringToUTF8(strN);
  if not Form1.FUseUTF8 or (strTemp = strN) then begin
    strTemp := Str2QP(strN);
    if strN = strTemp then
       sl.add('N:' + strN)
    else
       sl.Add('N;ENCODING=QUOTED-PRINTABLE:' + strTemp);
  end else
    sl.Add('N;CHARSET=UTF-8:' + strTemp);

  DisplayName := GetDisplayName;
  if DisplayName <> '' then begin
    strTemp := WideStringToUTF8(DisplayName);
    if not Form1.FUseUTF8 or (strTemp = DisplayName) then begin
      strTemp := Str2QP(DisplayName);
      if DisplayName = strTemp then
         sl.add('FN:' + DisplayName)
      else
         sl.Add('FN;ENCODING=QUOTED-PRINTABLE:' + strTemp);
    end else
      sl.Add('FN;CHARSET=UTF-8:' + strTemp);
  end;

  if Notes <> '' then begin
     strTemp := WideStringToUTF8(Notes);
     if not Form1.FUseUTF8 or (strTemp = Notes) or (Pos(#13,Notes) <> 0) then begin
       strTemp := Str2QP(Notes);
       if Notes = strTemp then
          sl.add('NOTE:' + Notes)
       else
          sl.Add('NOTE;ENCODING=QUOTED-PRINTABLE:' + strTemp);
     end else
       sl.Add('NOTE;CHARSET=UTF-8:' + strTemp);
  end;

  if Title <> '' then begin
     strTemp := WideStringToUTF8(Title);
     if not Form1.FUseUTF8 or (strTemp = Title) then begin
       strTemp := Str2QP(Title);
       if Title = strTemp then
          sl.add('TITLE:' + Title)
       else
          sl.Add('TITLE;ENCODING=QUOTED-PRINTABLE:' + strTemp);
     end else
       sl.Add('TITLE;CHARSET=UTF-8:' + strTemp);
  end;

  if Org <> '' then begin
     strTemp := WideStringToUTF8(Org);
     if not Form1.FUseUTF8 or (strTemp = Org) then begin
       strTemp := Str2QP(Org);
       if Org = strTemp then
          sl.add('ORG:' + Org)
       else
          sl.Add('ORG;ENCODING=QUOTED-PRINTABLE:' + strTemp);
     end else
       sl.Add('ORG;CHARSET=UTF-8:' + strTemp);
  end;

  if Email <> '' then
    sl.add('EMAIL;INTERNET;PREF:' + Email);
  for i := 0 to mails.Count-1 do
    sl.add('EMAIL;INTERNET:' + mails[i]);

  if BDay <> EmptyDate then begin
    DecodeDate(BDay,bY,bM,bD);
    sl.add(Format('BDAY:%.4d%.2d%.2d',[bY,bM,bD]));
  end;

  if URL <> '' then begin
    strTemp := WideStringToUTF8(URL);
    if not Form1.FUseUTF8 or (strTemp = URL) then begin
       strTemp := Str2QP(URL);
       if URL = strTemp then
          sl.add('URL:' + URL)
       else
          sl.Add('URL;ENCODING=QUOTED-PRINTABLE:' + strTemp);
     end else
       sl.Add('URL;CHARSET=UTF-8:' + strTemp);
  end;

  if TelHome <> '' then begin
    if TelPref <> 'H' then
      sl.add('TEL;HOME:' + TelHome)
    else
      sl.add('TEL;HOME;PREF:' + TelHome)
  end;
  if TelWork <> '' then begin
    if TelPref <> 'W' then
      sl.add('TEL;WORK:' + TelWork)
    else
      sl.add('TEL;WORK;PREF:' + TelWork)
  end;
  if TelCell <> '' then begin
    if TelPref <> 'M' then
      sl.add('TEL;CELL:' + TelCell)
    else
      sl.add('TEL;CELL;PREF:' + TelCell)
  end;
  if TelFax <> '' then begin
    if TelPref <> 'F' then
      sl.add('TEL;FAX:' + TelFax)
    else
      sl.add('TEL;FAX;PREF:' + TelFax)
  end;
  if TelOther <> '' then begin
    if TelPref <> 'O' then
      sl.add('TEL:' + TelOther)
    else
      sl.add('TEL;PREF:' + TelOther)
  end;

  slAddAdr('HOME',HomeAddress);
  slAddAdr('WORK',WorkAddress);

  // TODO: Optional, add support for photo image

  if UID <> '' then begin
     sl.add('UID:' + UID)
  end;

  if LUID <> '' then begin
     sl.add('X-IRMC-LUID:' + LUID)
  end;

  // REV:20040701T095208Z
  if ModifiedDate <> EmptyDate then begin
    sl.add('REV:'+FormatDateTime('yyyymmdd"T"hhnnss',ModifiedDate)); // Add "Z" for UTC
  end;

  if VType = '' then
     sl.Add('END:VCARD')
  else
     sl.Add('END:' + VType);
  Result := sl;
end;

procedure TVCard.setProperty(Value: String);
const
  ValueRaw: String = '';
var
  grp,grpdescr,nmedescr: String;
  PName,PParams,PValue:String;   // Schnorbsl : P stands for property
  PWValue, str: WideString;
  i,j,k: integer;

  function IsField(FName,Value: string): boolean;
  var
    i,j: integer;
  begin
    i := Length(FName);
    j := Length(Value);
    Result := (Pos(FName,Value) = 1) and ((i = j) or
      (Value[i+1] in [';',':']) or (FName[i] in [';',':']));
  end;

  procedure ProcessAdr(AName: string; var Adr: TPostalAddress; var Value: WideString);
  begin
    with Adr do
      if Pos(AName,PParams) <> 0 then begin
          str := Value;

          // skip POST OFFICE ADDRESS
          if pos(';', str) > 0 then
             str := copy(str, pos(';', str) + 1, length(str));
          // skip EXTENDED ADDDRESS
          if pos(';', str) > 0 then
             str := copy(str, pos(';', str) + 1, length(str));
          // Street
          if pos(';', str) > 0 then begin
             Street := copy(str, 0, pos(';', str) - 1);
             str := copy(str, pos(';', str) + 1, length(str));
          end;
          // City
          if pos(';', str) > 0 then begin
             City := copy(str, 0, pos(';', str) - 1);
             str := copy(str, pos(';', str) + 1, length(str));
          end;