idvcard.pas

Indy控件的使用源代码

    FSound : TIdVCardEmbeddedObject;
    FKey : TIdVCardEmbeddedObject;
    procedure SetComments(Value : TStrings);
    procedure SetCategories(Value : TStrings);
    procedure SetURLs(Value : TStrings);
    {This processes some types of variables after reading the string}
    procedure SetVariablesAfterRead;
  public
    constructor Create(AOwner: TComponent ); override;
    destructor Destroy; override;
    { This reads a VCard from a TStrings object }
    procedure ReadFromTStrings ( s : TStrings );
    { This is the raw form of the VCard }
    property RawForm : TStrings read FRawForm;
  published
    { This is the VCard specification version used }
    property VCardVersion : Real read FVCardVersion;
    { URL's associated with the VCard such as the person's or organication's  
    webpage.  There can be more than one.}
    property URLs : TStrings read FURLs write SetURLs;
    { This is the product ID for the program which created this VCard}
    property ProductID : String read FProductID write FProductID;
    { This is a unique indentifier for the VCard }
    property UniqueID : String read FUniqueID write FUniqueID;
    { Intent of the VCard owner for general access to information described by the vCard
     VCard.}
    property Classification : String read FClassification write FClassification;
    { This is the person's birthday and possibly, time of birth}    {Do not Localize}
    property BirthDay : TDateTime read FBirthDay write FBirthDay;
    { This is the person's name }    {Do not Localize}
    property FullName : TIdVCardName read FFullName write FFullName;
    { This is the E-Mail program used by the card's owner}    {Do not Localize}
    property EMailProgram : String read FEMailProgram write FEMailProgram;
    { This is a list of the person's E-Mail address }    {Do not Localize}
    property EMailAddresses : TIdVCardEMailAddresses read FEMailAddresses;
    { This is a list of telephone numbers }
    property Telephones : TIdVCardTelephones read FTelephones;
    { This is busines related information on a VCard}
    property BusinessInfo : TIdVCardBusinessInfo read  FBusinessInfo;
    { This is a list of Categories used for classification }
    property Categories : TStrings read FCategories write SetCategories;
    { This is a list of addresses }
    property Addresses : TIdVCardAddresses read FAddresses;
    { This is a list of mailing labels }
    property MailingLabels : TIdVCardMailingLabels read FMailingLabels;
    { This is a miscellaneous comments, additional information, or whatever the
     VCard wishes to say }
    property Comments : TStrings read FComments write SetComments;
    { The owner's photograph}    {Do not Localize}
    property Photo : TIdVCardEmbeddedObject read FPhoto;
    { Organization's logo}    {Do not Localize}
    property Logo  : TIdVCardEmbeddedObject read FLogo;
    { A sound associated with the VCard such as how to pronounce a person's name  
      or something cute }
    property Sound : TIdVCardEmbeddedObject read FSound;
    { This is for an encryption key such as S/MIME, VeriSign, or PGP }
    property Key : TIdVCardEmbeddedObject read FKey;
  end;

implementation

uses
  IdCoderQuotedPrintable,
  SysUtils;

const VCardProperties : array [1..28] of string = (
'FN', 'N', 'NICKNAME', 'PHOTO',    {Do not Localize}
'BDAY', 'ADR', 'LABEL', 'TEL',    {Do not Localize}
'EMAIL', 'MAILER', 'TZ', 'GEO',    {Do not Localize}
'TITLE',  'ROLE', 'LOGO', 'AGENT',    {Do not Localize}
'ORG', 'CATEGORIES', 'NOTE', 'PRODID',    {Do not Localize}
'REV', 'SORT-STRING', 'SOUND', 'URL',    {Do not Localize}
'UID', 'VERSION', 'CLASS', 'KEY');    {Do not Localize}
{ These constants are for testing the VCard for E-Mail types.
  Don't alter these }    {Do not Localize}
const EMailTypePropertyParameter : array [1..12] of string =
       ('AOL', {America On-Line}    {Do not Localize}
        'APPLELINK',   {AppleLink}    {Do not Localize}
        'ATTMAIL', { AT&T Mail }    {Do not Localize}
        'CIS', { CompuServe Information Service }    {Do not Localize}
        'EWORLD', { eWorld }    {Do not Localize}
        'INTERNET', {Internet SMTP (default) }    {Do not Localize}
        'IBMMAIL', { IBM Mail }    {Do not Localize}
        'MCIMAIL', { MCI Mail }    {Do not Localize}
        'POWERSHARE', { PowerShare }    {Do not Localize}
        'PRODIGY', { Prodigy information service }    {Do not Localize}
        'TLX', { Telex number }    {Do not Localize}
        'X400' ); { X.400 service }    {Do not Localize}
        
function StrToFloat(const S: string):Extended;
var LOldDecimalSeparator:char;
    LOldThousandSeparator:char;
begin
  LOldDecimalSeparator:=DecimalSeparator;
  LOldThousandSeparator:=ThousandSeparator;
  DecimalSeparator:='.';
  ThousandSeparator:=',';
  try
    result:=SysUtils.StrToFloat(S);
  finally
    DecimalSeparator:=LOldDecimalSeparator;
    ThousandSeparator:=LOldThousandSeparator;
  end;
end;

{This only adds Value to strs if it is not zero}
procedure AddValueToStrings(strs : TStrings; Value : String);
begin
  if ( Length ( Value )<>0) then
  begin
    strs.Add ( Value );
  end; //  if Legnth ( Value ) then
end;

{This parses a delinated string into a TStrings}
Procedure ParseDelinatorToTStrings ( strs : TStrings; str : String;
  deliniator : Char = ',' );    {Do not Localize}
begin
  while (str <> '') do    {Do not Localize}
  begin
    AddValueToStrings(  strs, Fetch ( str, deliniator ) );
  end; // while (str <> '') do    {Do not Localize}
end;

{This parses time stamp from DateString and returns it as TDateTime
This assumes the date Time stamp will be like this:

1995-10-31T22:27:10Z

1997-11-15
}
Function ParseDateTimeStamp ( DateString : String ) : TDateTime;
var Year, Day, Month : Integer;
    Hour, Minute, Second : Integer;
begin
    Year  := StrToInt ( Copy ( DateString, 1, 4 ) );
    Month := StrToInt ( Copy (DateString, 5, 2 ) );
    Day   := StrToInt ( Copy ( DateString, 7, 2 ) );
    if ( Length ( DateString ) > 14 ) then
    begin
      Hour := StrToInt ( Copy ( DateString, 10, 2 ) );
      Minute := StrToInt ( Copy ( DateString, 12, 2 ) );
      Second := StrToInt ( Copy ( DateString, 14, 2 ) );
    end //if ( Length ( DateString ) > 18 ) then
    else    { no date }
    begin
      Hour := 0;
      Minute := 0;
      Second := 0;
    end; // else .. if ( Length ( DateString ) > 18 ) then
//    DateStamp.AsISO8601Calender := DateString;
    Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Minute, Second,0);
end;

{This function returns a stringList with an item's attributes    
and sets value to the value of the item - everything in the stringlist is
capitalized to facilitate parsing which is Case-Insensitive}
Function GetAttributesAndValue (data : String; var value : String) : TStringList;
var Buff, Buff2 : String;
begin
  Result := TStringList.Create;
  Result.Sorted := False;
  if IndyPos(':',Data) <> 0 then    {Do not Localize}
  begin
    Buff := idGlobal.Fetch( Data, ':' );    {Do not Localize}
    {This handles a VCard property attribute deliniator ","}
    Buff := StringReplace(Buff,',',';', [ rfReplaceAll ] );    {Do not Localize}
    while ( Buff <> '' ) do    {Do not Localize}
    begin
      Buff2 := IdGlobal.Fetch ( Buff, ';' );    {Do not Localize}
      if ( Length ( Buff2 ) > 0 ) then
      begin
        Result.Add ( UpperCase( Buff2 ) );
      end; // if Length ( Buff2 ) > 0) then
    end; // while ( Buff <> '' ) do    {Do not Localize}
  end; // if Pos(':',Data) <> 0 then    {Do not Localize}
  Value := Data;
end;

{This parses the organization line from OrgString into}
procedure ParseOrg ( OrgObj : TIdVCardBusinessInfo; OrgStr : String);
begin
  { Organization name }
  OrgObj.Organization := Fetch ( OrgStr );
  { Divisions }
  ParseDelinatorToTStrings ( OrgObj.Divisions, OrgStr, ';' );    {Do not Localize}
end;

{This parses the geography latitude and longitude from GeogStr and
 puts it in Geog}
procedure ParseGeography ( Geog : TIdVCardGeog; GeogStr : String );
begin
  {Latitude}
  Geog.Latitude := StrToFloat ( Fetch ( GeogStr, ';' ) );    {Do not Localize}
  {Longitude}
  Geog.Longitude := StrToFloat ( Fetch ( GeogStr, ';' ) );    {Do not Localize}
end;

{This parses  PhoneStr and places the attributes in PhoneObj }
Procedure ParseTelephone ( PhoneObj : TIdCardPhoneNumber; PhoneStr : String);
var Value : String;
    idx : Integer;
    Attribs : TStringList;

const  TelephoneTypePropertyParameter : array [ 0..13 ] of string  =
   ( 'HOME', 'MSG',   'WORK', 'PREF',  'VOICE',  'FAX',    {Do not Localize}
     'CELL', 'VIDEO',  'BBS', 'MODEM', 'CAR',   'ISDN',    {Do not Localize}
     'PCS', 'PAGER' );    {Do not Localize}
begin
  attribs := GetAttributesAndValue ( PhoneStr, Value );
  try
    idx := 0;
    while idx < Attribs.Count do
    begin
      case idGlobal.PosInStrArray ( attribs [ idx ], TelephoneTypePropertyParameter ) of
        { home }
        0 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaHome ];
        { voice messaging }
        1 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaVoiceMessaging ];
        { work }
        2 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaWork ];
        { preferred }
        3 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaPreferred ];
        { Voice }
        4 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaVoice ];
        { Fax }
        5 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaFax ];
        { Cellular phone }
        6 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaCellular ];
        { Video conferancing number }
        7 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaVideo ];
        { Bulleton Board System (BBS) telephone number }
        8 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaBBS ];
        { MODEM Connection number }
        9 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaModem ];
        { Car phone number }
       10 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaCar ];
        { ISDN Service Number }
       11 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaISDN ];
       { personal communication services telephone number }
       12 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaPCS ];
       { pager }
       13 : PhoneObj.PhoneAttributes := PhoneObj.PhoneAttributes + [ tpaPager ];
      end;
      inc ( idx );
    end;  //while idx < Attribs.Count do
    { default telephon number }
    if ( Attribs.Count = 0 ) then
    begin
      PhoneObj.PhoneAttributes := [ tpaVoice ];
    end; // if (Attribs.Count = 0) then
    PhoneObj.Number := Value;
  finally
    FreeAndNil ( attribs );
  end;  //try..finally
end;

{This parses AddressStr and places the attributes in AddressObj }
Procedure ParseAddress ( AddressObj : TIdCardAddressItem; AddressStr : String);
var Value : String;
    Attribs : TStringList;
    idx : Integer;
const AttribsArray : Array[0..6] of String =
  ( 'HOME', 'DOM', 'INTL', 'POSTAL', 'PARCEL', 'WORK', 'PREF' );    {Do not Localize}
begin
  Attribs := GetAttributesAndValue ( AddressStr, Value );
  try
    idx := 0;
    while idx < Attribs.Count do
    begin
      case idGlobal.PosInStrArray ( attribs [ idx ], AttribsArray ) of
        { home }
        0 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatHome ];
        { domestic }
        1 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatDomestic ];
        { international }
        2 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatInternational ];
        { Postal }
        3 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatPostal ];
        { Parcel }
        4 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatParcel ];
        { Work }
        5 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatWork ];
        { Preferred }
        6 : AddressObj.AddressAttributes :=
              AddressObj.AddressAttributes + [ tatPreferred ];
      end;
      inc ( idx );
    end;  //while idx < Attribs.Count do
    if (Attribs.Count = 0) then
    begin
      AddressObj.AddressAttributes := [ tatInternational, tatPostal, tatParcel, tatWork ];
    end;
    AddressObj.POBox := idGlobal.Fetch ( Value, ';' );    {Do not Localize}
    AddressObj.ExtendedAddress := idGlobal.Fetch( Value, ';' );    {Do not Localize}
    AddressObj.StreetAddress := idGlobal.Fetch ( Value,';' );    {Do not Localize}
    AddressObj.Locality := idGlobal.Fetch ( Value, ';' );    {Do not Localize}
    AddressObj.Region := idGlobal.Fetch ( Value, ';' );    {Do not Localize}
    AddressObj.PostalCode := idGlobal.Fetch ( Value, ';' );    {Do not Localize}
    AddressObj.Nation:= idGlobal.Fetch ( Value, ';' );    {Do not Localize}
  finally
    FreeAndNil ( Attribs );
  end;  //try..finally
end;

{This parses LabelStr and places the attributes in TIdVCardMailingLabelItem }
Procedure ParseMailingLabel ( LabelObj : TIdVCardMailingLabelItem; LabelStr : String);
var Value : String;
    Attribs : TStringList;
    idx : Integer;
const AttribsArray : Array[0..6] of String =
  ( 'HOME', 'DOM', 'INTL', 'POSTAL', 'PARCEL', 'WORK', 'PREF' );    {Do not Localize}
begin
  Attribs := GetAttributesAndValue ( LabelStr, Value );
  try
    idx := 0;
    while idx < Attribs.Count do
    begin
      case idGlobal.PosInStrArray ( attribs [ idx ], AttribsArray ) of
        { home }
        0 : LabelObj.AddressAttributes :=
              LabelObj.AddressAttributes + [ tatHome ];
        { domestic }
        1 : LabelObj.AddressAttributes :=
              LabelObj.AddressAttributes + [ tatDomestic ];
        { international }
        2 : LabelObj.AddressAttributes :=
              LabelObj.AddressAttributes + [ tatInternational ];
        { Postal }
        3 : LabelObj.AddressAttributes :=
              LabelObj.AddressAttributes + [ tatPostal ];
        { Parcel }
        4 : LabelObj.AddressAttributes :=
              LabelObj.AddressAttributes + [ tatParcel ];
        { Work }
        5 : LabelObj.AddressAttributes :=
             LabelObj.AddressAttributes + [ tatWork ];
        { Preferred }
        6 : LabelObj.AddressAttributes :=