idvcard.pas

Indy控件的使用源代码

      begin
        if Line[ColonFind] = ';' then    {Do not Localize}
        begin
          Line := Copy(Line, 1, ColonFind - 1);
        end;
      end;
      Line := Line + ':' + Data;    {Do not Localize}
    end;
    //****  End QP check & decode

    Colon := IndyPos(':', Line);    {Do not Localize}
    SColon := IndyPos(';', Line);    {Do not Localize}
    if ( Colon < SColon ) or ( SColon = 0 ) then
    begin
      Line := StringReplace ( Line, ':', ';', [ ] );    {Do not Localize}
    end;

    // Grab the property name
    Test := UpperCase ( Fetch ( Line,';') );    {Do not Localize}

    // Discover which property it is.
    case PosInStrArray( Test, VCardProperties ) of
     {'FN'}    {Do not Localize}
      0 : FFullName.FormattedName := Line + UnfoldLines;
     {'N'}    {Do not Localize}
      1 : ParseName ( FFullName, Line + UnfoldLines );
     {'NICKNAME'}    {Do not Localize}
      2 : ParseDelinatorToTStrings ( FFullName.NickNames , Line + UnfoldLines );
     {'PHOTO'}    {Do not Localize}
      3 : ParseEmbeddedObject ( FPhoto, Line );
     {'BDAY'}    {Do not Localize}
      4 : FBirthDay := ParseDateTimeStamp ( Line + UnfoldLines );
     {'ADR'}    {Do not Localize}
      5 : ParseAddress ( FAddresses.Add, Line + UnfoldLines );
     {'LABEL'}    {Do not Localize}
      6 : ParseMailingLabel (FMailingLabels.Add, Line + UnfoldLines );
     {'TEL'}    {Do not Localize}
      7 : ParseTelephone ( FTelephones.Add, Line + UnfoldLines );
     {'EMAIL'}    {Do not Localize}
      8 : ParseEMailAddress ( FEMailAddresses.Add, Line + UnfoldLines );
     {'MAILER'}    {Do not Localize}
      9 : FEMailProgram := Line + UnfoldLines;
     {'TZ'}    {Do not Localize}
     10 : FGeography.TimeZoneStr := Line + UnfoldLines;
     {'GEO'}    {Do not Localize}
     11 : ParseGeography ( FGeography, Line + UnfoldLines );
     {'TITLE'}    {Do not Localize}
     12 : FBusinessInfo.Title := Line + UnfoldLines;
     {'ROLE'}    {Do not Localize}
     13 : FBusinessInfo.Role := Line + UnfoldLines;
     {'LOGO'}    {Do not Localize}
     14 :  ParseEmbeddedObject ( FLogo, Line );
     {'AGENT'}    {Do not Localize}
     15 : ProcessAgent;
     {'ORG'}    {Do not Localize}
     16 : ParseOrg ( FBusinessInfo, Line + UnfoldLines );
     {'CATEGORIES'}    {Do not Localize}
     17 :  ParseDelinatorToTStrings ( FCategories, Line + UnfoldLines );
     {'NOTE'}    {Do not Localize}
     18 :  FComments.Add ( Line +UnfoldLines );
     {'PRODID' }    {Do not Localize}
     19 : FProductID := Line + UnfoldLines;
     {'REV'}    {Do not Localize}
     20 : FLastRevised := ParseDateTimeStamp ( Line + UnfoldLines );
     {'SORT-STRING'}    {Do not Localize}
     21 : FFullName.SortName := Line + UnfoldLines;
     {'SOUND'}    {Do not Localize}
     22 :  ParseEmbeddedObject ( FSound, Line );
     {'URL'}    {Do not Localize}
     23 : AddValueToStrings( FURLs, Line + UnfoldLines );
     {'UID'}    {Do not Localize}
     24 : FUniqueID := Line + UnfoldLines;
     {'VERSION'}    {Do not Localize}
     25 : FVCardVersion := StrToFloat ( Line  + UnfoldLines );
     {'CLASS'}    {Do not Localize}
     26 :  FClassification := Line  + UnfoldLines;
     {'KEY'}    {Do not Localize}
     27 : ParseEmbeddedObject ( FKey, Line );
    end;
    inc ( idx );
  end; // while idx < FRawForm.Count do

  finally
    QPCoder.Free;
  end;
end;

{ TIdVCardEMailAddresses }

function TIdVCardEMailAddresses.Add: TIdVCardEMailItem;
begin
  Result := TIdVCardEMailItem(inherited Add);
end;

constructor TIdVCardEMailAddresses.Create ( AOwner : TPersistent );
begin
  inherited Create ( AOwner, TIdVCardEMailItem );
end;

function TIdVCardEMailAddresses.GetItem(Index: Integer): TIdVCardEMailItem;
begin
  Result := TIdVCardEMailItem ( inherited Items [ Index ] );
end;

procedure TIdVCardEMailAddresses.SetItem(Index: Integer;
  const Value: TIdVCardEMailItem);
begin
  inherited SetItem ( Index, Value );
end;

{ TIdVCardEMailItem }

procedure TIdVCardEMailItem.Assign(Source: TPersistent);
var EMail : TIdVCardEMailItem;
begin
  if ClassType <> Source.ClassType then
  begin
    inherited
  end
  else
  begin
    EMail := TIdVCardEMailItem(Source);
    EMailType := EMail.EMailType;
    Preferred := EMail.Preferred;
    Address := EMail.Address;
  end;
end;

constructor TIdVCardEMailItem.Create(Collection: TCollection);
begin
  inherited;
  FEMailType := ematInternet;
end;

{ TIdVCardAddresses }

function TIdVCardAddresses.Add: TIdCardAddressItem;
begin
   Result := TIdCardAddressItem ( inherited Add );
end;

constructor TIdVCardAddresses.Create ( AOwner : TPersistent );
begin
   inherited Create ( AOwner, TIdCardAddressItem );
end;

function TIdVCardAddresses.GetItem(Index: Integer): TIdCardAddressItem;
begin
  Result := TIdCardAddressItem ( inherited Items [ Index ] );
end;

procedure TIdVCardAddresses.SetItem(Index: Integer;
  const Value: TIdCardAddressItem);
begin
  inherited SetItem ( Index, Value );
end;

{ TIdVCardTelephones }

function TIdVCardTelephones.Add: TIdCardPhoneNumber;
begin
  Result := TIdCardPhoneNumber ( inherited Add );
end;

constructor TIdVCardTelephones.Create ( AOwner : TPersistent );
begin
   inherited Create ( AOwner, TIdCardPhoneNumber );
end;

function TIdVCardTelephones.GetItem(Index: Integer): TIdCardPhoneNumber;
begin
   Result := TIdCardPhoneNumber ( inherited Items [ Index ] );
end;

procedure TIdVCardTelephones.SetItem(Index: Integer;
  const Value: TIdCardPhoneNumber);
begin
  inherited SetItem ( Index, Value );
end;

{ TIdVCardName }

constructor TIdVCardName.Create;
begin
  inherited;
  FOtherNames := TStringList.Create;
  FNickNames := TStringList.Create;
end;

destructor TIdVCardName.Destroy;
begin
  FreeAndNil ( FNickNames );
  FreeAndNil ( FOtherNames );
  inherited;
end;

procedure TIdVCardName.SetNickNames(Value: TStrings);
begin
  FNickNames.Assign(Value);
end;

procedure TIdVCardName.SetOtherNames(Value: TStrings);
begin
  FOtherNames.Assign(Value);
end;

{ TIdVCardBusinessInfo }

constructor TIdVCardBusinessInfo.Create;
begin
  inherited;
  FDivisions := TStringList.Create;
end;

destructor TIdVCardBusinessInfo.Destroy;
begin
  FreeAndNil ( FDivisions );
  inherited;
end;

procedure TIdVCardBusinessInfo.SetDivisions(Value: TStrings);
begin
  FDivisions.Assign(Value);
end;

{ TIdVCardMailingLabelItem }

procedure TIdVCardMailingLabelItem.Assign(Source: TPersistent);
var lbl : TIdVCardMailingLabelItem;
begin
  if ClassType <> Source.ClassType then
  begin
    inherited
  end
  else
  begin
    lbl := TIdVCardMailingLabelItem(Source);
    AddressAttributes := lbl.AddressAttributes;
    MailingLabel.Assign(lbl.MailingLabel);
  end;
end;

constructor TIdVCardMailingLabelItem.Create(Collection: TCollection);
begin
  inherited;
  FMailingLabel := TStringList.Create;
end;

destructor TIdVCardMailingLabelItem.Destroy;
begin
  FreeAndNil ( FMailingLabel );
  inherited;
end;

procedure TIdVCardMailingLabelItem.SetMailingLabel(Value: TStrings);
begin
  FMailingLabel.Assign(Value);
end;

{ TIdVCardMailingLabels }

function TIdVCardMailingLabels.Add: TIdVCardMailingLabelItem;
begin
  Result := TIdVCardMailingLabelItem ( inherited Add );
end;

constructor TIdVCardMailingLabels.Create(AOwner: TPersistent);
begin
  inherited Create (AOwner, TIdVCardMailingLabelItem );
end;

function TIdVCardMailingLabels.GetItem(
  Index: Integer): TIdVCardMailingLabelItem;
begin
  Result := TIdVCardMailingLabelItem ( inherited GetItem ( Index ) );
end;

procedure TIdVCardMailingLabels.SetItem(Index: Integer;
  const Value: TIdVCardMailingLabelItem);
begin
  inherited SetItem ( Index, Value );
end;

{ TIdEmbeddedObject }

constructor TIdVCardEmbeddedObject.Create;
begin
  inherited;
  FEmbeddedData := TStringList.Create;
end;

destructor TIdVCardEmbeddedObject.Destroy;
begin
  FreeAndNil ( FEmbeddedData );
  inherited;
end;

procedure TIdVCardEmbeddedObject.SetEmbeddedData(const Value: TStrings);
begin
  FEmbeddedData.Assign(Value);
end;

{ TIdCardPhoneNumber }

procedure TIdCardPhoneNumber.Assign(Source: TPersistent);
var Phone : TIdCardPhoneNumber;
begin
  if ClassType <> Source.ClassType then
  begin
    inherited;
  end
  else
  begin
    Phone := TIdCardPhoneNumber(Source);
    PhoneAttributes := Phone.PhoneAttributes;
    Number := Phone.Number;
  end;
end;

{ TIdCardAddressItem }

procedure TIdCardAddressItem.Assign(Source: TPersistent);
var Addr : TIdCardAddressItem;
begin
  if ClassType <> Source.ClassType then
  begin
    inherited;
  end
  else
  begin
    Addr := TIdCardAddressItem(Source);
    AddressAttributes := Addr.AddressAttributes;
    POBox := Addr.POBox;
    ExtendedAddress := Addr.ExtendedAddress;
    StreetAddress := Addr.StreetAddress;
    Locality := Addr.Locality;
    Region := Addr.Region;
    PostalCode := Addr.PostalCode;
    Nation := Addr.Nation;
  end;
end;

end.