Generate a VCard

Share your advanced PureBasic knowledge/code with the community.
User avatar
Progi1984
Addict
Addict
Posts: 806
Joined: Fri Feb 25, 2005 1:01 am
Location: France > Rennes
Contact:

Generate a VCard

Post by Progi1984 »

This a toolset of functions for generating easily a VCard.

Manage the format VCard 2.1 & 3.0.

VCard : Wikipedia

Code: Select all

Enumeration ; Version
  #VCard_Version_2_1
  #VCard_Version_3_0
EndEnumeration
Enumeration ; Errors
  #VCard_ErrorType_Success
  #VCard_ErrorType_FileAccess
  #VCard_ErrorType_
EndEnumeration
Enumeration ; Types Phone
  #VCard_PhoneType_PREF   = 1
  #VCard_PhoneType_WORK   = 2
  #VCard_PhoneType_HOME   = 4
  #VCard_PhoneType_VOICE  = 8
  #VCard_PhoneType_FAX    = 16
  #VCard_PhoneType_MSG    = 32
  #VCard_PhoneType_CELL   = 64
  #VCard_PhoneType_PAGER  = 128
  #VCard_PhoneType_BBS    = 256
  #VCard_PhoneType_CAR    = 512
  #VCard_PhoneType_MODEM  = 1024
  #VCard_PhoneType_ISDN   = 2048
  #VCard_PhoneType_VIDEO  = 4096
EndEnumeration
Enumeration ; Types Adress
  #VCard_AdressType_DOM   = 1
  #VCard_AdressType_INTL  = 2
  #VCard_AdressType_POSTAL= 4
  #VCard_AdressType_PARCEL= 8
  #VCard_AdressType_HOME  = 16
  #VCard_AdressType_WORK  = 32
EndEnumeration
Enumeration ; Types Url
  #VCard_UrlType_HOME     = 1
  #VCard_UrlType_WORK     = 2
EndEnumeration

Structure S_VCard_Phone
  sPhoneNumber.s
  lPhoneType.l
EndStructure
Structure S_VCard_Adress
  sPostOfficeBox.s
  sExtendAdress.s
  sStreet.s
  sLocality.s
  sRegion.s
  sPostalCode.s
  sCountryName.s
  lAdressType.l
EndStructure
Structure S_VCard_Url
  sUrl.s
  lUrlType.l
EndStructure
Structure S_VCard
  lVersion.l
  sMailer.s
  sFirstName.s    ; Prenom
  sLastName.s     ; Nom
  sBirthday.s
  sEMail.s
  sNote.s
  sSociety.s      ; Societe
  sTitle.s        ; Title
  sTelWork.s      ; Tel > Work
  lPhoneNum.l     ; Number of PhoneNumber
  dimPhoneNum.S_VCard_Phone[20]
  lAdressNum.l    ; Number of Adress
  dimAdress.S_VCard_Adress[20]
  lURLNum.l       ; Number of URL
  dimURL.S_VCard_URL[20]
EndStructure

ProcedureDLL VCard_Write(*VCard.S_VCard, Filename.s)
  Protected plFile.l
  Protected plVarTmp.l
  Protected psVarTmp.s
  Protected psEndOfLine.s
  Protected psTypeSeparator.s
  Protected psTypeStart.s
  Protected psTypeEnd.s
  
  plFile = OpenFile(#PB_Any, Filename)
  If plFile
    If *VCard\lVersion = #VCard_Version_2_1
      psEndOfLine = Chr(13)+Chr(10)
      psTypeSeparator = ";"
      psTypeStart = ";"
      psTypeEnd = ""
    Else
      psEndOfLine = Chr(10)
      psTypeSeparator = ","
      psTypeStart = ";TYPE="
      psTypeEnd = ""
    EndIf
  
    WriteString(plFile, "BEGIN:VCARD"+psEndOfLine)
    ; Version
    If *VCard\lVersion = #VCard_Version_2_1
      WriteString(plFile, "VERSION:2.1"+psEndOfLine)
    Else
      WriteString(plFile, "VERSION:3.0"+psEndOfLine)
    EndIf
    ; Name
    WriteString(plFile, "N:"+*VCard\sLastName+";"+*VCard\sFirstName+psEndOfLine)
    ; Formatted Name
    WriteString(plFile, "FN:"+*VCard\sFirstName+" "+*VCard\sLastName+psEndOfLine)
    ; Organization Name 
    If Len(*VCard\sSociety) > 0
      WriteString(plFile, "ORG:"+*VCard\sSociety+psEndOfLine)
    EndIf
    ; Title
    If Len(*VCard\sTitle) > 0
      WriteString(plFile, "TITLE:"+*VCard\sTitle+psEndOfLine)
    EndIf
    ; Birthday
    If Len(*VCard\sBirthday) > 0
      WriteString(plFile, "BDAY:"+*VCard\sBirthday+psEndOfLine)
    EndIf
    ; Mail
    If Len(*VCard\sEMail) > 0
      WriteString(plFile, "EMAIL"+psTypeStart+"INTERNET"+psTypeEnd+":"+*VCard\sEMail+psEndOfLine)
    EndIf
    ; Note  
    If Len(*VCard\sNote) > 0
      WriteString(plFile, "NOTE;ENCODING=QUOTED-PRINTABLE:"+*VCard\sNote+psEndOfLine)
    EndIf
    ; URL
    If *VCard\lURLNum > 0
      For plInc = 0 To *VCard\lURLNum
        Select *VCard\dimURL[plInc]\lUrlType
          Case #VCard_UrlType_HOME : WriteString(plFile, "URL"+psTypeStart+"HOME"+psTypeEnd+":"+*VCard\dimURL[plInc]\sUrl+psEndOfLine)
          Case #VCard_UrlType_WORK : WriteString(plFile, "URL"+psTypeStart+"WORK"+psTypeEnd+":"+*VCard\dimURL[plInc]\sUrl+psEndOfLine)
        EndSelect
      Next
    EndIf
    ; Adresses
    If *VCard\lAdressNum > 0
      For plInc = 0 To *VCard\lAdressNum -1
        plVarTmp = *VCard\dimAdress[plInc]\lAdressType
        psVarTmp = ""
        If plVarTmp & #VCard_AdressType_WORK
          plVarTmp - #VCard_AdressType_WORK
          psVarTmp + psTypeSeparator + "WORK"
        EndIf
        If plVarTmp & #VCard_AdressType_HOME
          plVarTmp - #VCard_AdressType_HOME
          psVarTmp + psTypeSeparator + "HOME"
        EndIf
        If plVarTmp & #VCard_AdressType_PARCEL
          plVarTmp - #VCard_AdressType_PARCEL
          psVarTmp + psTypeSeparator + "PARCEL"
        EndIf
        If plVarTmp & #VCard_AdressType_POSTAL
          plVarTmp - #VCard_AdressType_POSTAL
          psVarTmp + psTypeSeparator + "POSTAL"
        EndIf
        If plVarTmp & #VCard_AdressType_INTL
          plVarTmp - #VCard_AdressType_INTL
          psVarTmp + psTypeSeparator + "INTL"
        EndIf
        If plVarTmp & #VCard_AdressType_DOM
          plVarTmp - #VCard_AdressType_DOM
          psVarTmp + psTypeSeparator + "DOM"
        EndIf
        psVarTmp = Right(psVarTmp, Len(psVarTmp) - 1)
        WriteString(plFile, "ADR"+psTypeStart+psVarTmp+psTypeEnd+":"+*VCard\dimAdress[plInc]\sPostOfficeBox+";"+*VCard\dimAdress[plInc]\sExtendAdress+";"+*VCard\dimAdress[plInc]\sStreet+";"+*VCard\dimAdress[plInc]\sLocality+";"+*VCard\dimAdress[plInc]\sRegion+";"+*VCard\dimAdress[plInc]\sPostalCode+";"+*VCard\dimAdress[plInc]\sCountryName+psEndOfLine)
      Next
    EndIf
    ; Phone Number
    If *VCard\lPhoneNum > 0
      For plInc = 0 To *VCard\lPhoneNum -1
        plVarTmp = *VCard\dimPhoneNum[plInc]\lPhoneType
        psVarTmp = ""
        If plVarTmp & #VCard_PhoneType_VIDEO
          plVarTmp - #VCard_PhoneType_VIDEO
          psVarTmp + psTypeSeparator + "VIDEO"
        EndIf
        If plVarTmp & #VCard_PhoneType_ISDN
          plVarTmp - #VCard_PhoneType_ISDN
          psVarTmp + psTypeSeparator + "ISDN"
        EndIf
        If plVarTmp & #VCard_PhoneType_MODEM
          plVarTmp - #VCard_PhoneType_MODEM
          psVarTmp + ";MODEM"
        EndIf
        If plVarTmp & #VCard_PhoneType_CAR
          plVarTmp - #VCard_PhoneType_CAR
          psVarTmp + psTypeSeparator + "CAR"
        EndIf
        If plVarTmp & #VCard_PhoneType_BBS
          plVarTmp - #VCard_PhoneType_BBS
          psVarTmp + ";BBS"
        EndIf
        If plVarTmp & #VCard_PhoneType_PAGER
          plVarTmp - #VCard_PhoneType_PAGER
          psVarTmp + psTypeSeparator + "PAGER"
        EndIf
        If plVarTmp & #VCard_PhoneType_CELL
          plVarTmp - #VCard_PhoneType_CELL
          psVarTmp + psTypeSeparator + "CELL"
        EndIf
        If plVarTmp & #VCard_PhoneType_MSG
          plVarTmp - #VCard_PhoneType_MSG
          psVarTmp + psTypeSeparator + "MSG"
        EndIf
        If plVarTmp & #VCard_PhoneType_FAX
          plVarTmp - #VCard_PhoneType_FAX
          psVarTmp + psTypeSeparator + "FAX"
        EndIf
        If plVarTmp & #VCard_PhoneType_VOICE
          plVarTmp - #VCard_PhoneType_VOICE
          psVarTmp + psTypeSeparator + "VOICE"
        EndIf
        If plVarTmp & #VCard_PhoneType_HOME
          plVarTmp - #VCard_PhoneType_HOME
          psVarTmp + psTypeSeparator + "HOME"
        EndIf
        If plVarTmp & #VCard_PhoneType_WORK
          plVarTmp - #VCard_PhoneType_WORK
          psVarTmp + psTypeSeparator + "WORK"
        EndIf
        If plVarTmp & #VCard_PhoneType_PREF
          plVarTmp - #VCard_PhoneType_PREF
          psVarTmp + psTypeSeparator + "PREF"
        EndIf
        psVarTmp = Right(psVarTmp, Len(psVarTmp) - 1)
        WriteString(plFile, "TEL"+psTypeStart+psVarTmp+psTypeEnd+":"+*VCard\dimPhoneNum[plInc]\sPhoneNumber+psEndOfLine)
      Next
    EndIf
    ; Revision
    WriteString(plFile, "REV:"+FormatDate("%yyyy%mm%dd", Date())+"T"+FormatDate("%hh%ii%ss", Date())+"Z"+psEndOfLine)
    ; Mailer
    If Len(*VCard\sMailer) > 0
      WriteString(plFile, "MAILER:"+*VCard\sMailer+psEndOfLine)
    EndIf
    WriteString(plFile, "END:VCARD"+psEndOfLine)
    CloseFile(plFile)
  Else
    ProcedureReturn #VCard_ErrorType_FileAccess
  EndIf
EndProcedure

ProcedureDLL VCard_SetVersion(*VCard.S_VCard, Version.l = #VCard_Version_2_1)
  *VCard\lVersion = Version
EndProcedure
ProcedureDLL VCard_SetName(*VCard.S_VCard, sFirstName.s, sLastName.s)
  *VCard\sFirstName  = sFirstName
  *VCard\sLastName   = sLastName
EndProcedure
ProcedureDLL VCard_SetBirthday(*VCard.S_VCard, lDate.l)
  *VCard\sBirthday = FormatDate("%yyyy-%mm-%dd", lDate)
EndProcedure
ProcedureDLL VCard_SetAdress(*VCard.S_VCard, sPostOfficeBox.s, sExtendAdress.s, sStreet.s, sLocality.s, sRegion.s, sPostalCode.s, sCountryName.s, lType.l)
  *VCard\dimAdress[*VCard\lAdressNum]\sPostOfficeBox  = sPostOfficeBox
  *VCard\dimAdress[*VCard\lAdressNum]\sExtendAdress   = sExtendAdress
  *VCard\dimAdress[*VCard\lAdressNum]\sStreet         = sStreet
  *VCard\dimAdress[*VCard\lAdressNum]\sLocality       = sLocality
  *VCard\dimAdress[*VCard\lAdressNum]\sRegion         = sRegion
  *VCard\dimAdress[*VCard\lAdressNum]\sPostalCode     = sPostalCode
  *VCard\dimAdress[*VCard\lAdressNum]\sCountryName    = sCountryName
  *VCard\dimAdress[*VCard\lAdressNum]\lAdressType     = lType
  *VCard\lAdressNum +1            
EndProcedure
ProcedureDLL VCard_SetEmail(*VCard.S_VCard, sEMail.s)
  *VCard\sEMail  = sEMail
EndProcedure
ProcedureDLL VCard_SetNote(*VCard.S_VCard, sNote.s)
  *VCard\sNote  = sNote
EndProcedure
ProcedureDLL VCard_SetMailer(*VCard.S_VCard, sMailer.s)
  *VCard\sMailer  = sMailer
EndProcedure
ProcedureDLL VCard_SetURL(*VCard.S_VCard, sURL.s, lType)
  *VCard\dimURL[*VCard\lURLNum]\sUrl      = sURL
  *VCard\dimURL[*VCard\lURLNum]\lUrlType  = lType
  *VCard\lURLNum +1
EndProcedure
ProcedureDLL VCard_SetPhoneNumber(*VCard.S_VCard, sPhoneNumber.s, lType.l)
  *VCard\dimPhoneNum[*VCard\lPhoneNum]\sPhoneNumber = sPhoneNumber
  *VCard\dimPhoneNum[*VCard\lPhoneNum]\lPhoneType   = lType
  *VCard\lPhoneNum +1
EndProcedure
ProcedureDLL VCard_SetJob(*VCard.S_VCard, sCompany.s, sJobName.s)
  *VCard\sSociety    = sCompany
  *VCard\sTitle     = sJobName
EndProcedure

MyCard.S_VCard

VCard_SetName(@MyCard, "Franck", "LEFEVRE")
VCard_SetBirthday(@MyCard, Date(1984, 11, 30, 0, 0, 0))
VCard_SetEmail(@MyCard, "progi1984@gmail.com")
VCard_SetJob(@MyCard, "RootsLabs", "Web & PB Developper")
VCard_SetNote(@MyCard, "Test Note")
VCard_SetMailer(@MyCard, "PBMailer")
VCard_SetURL(@MyCard, "http://www.rootslabs.net", #VCard_UrlType_HOME)
VCard_SetURL(@MyCard, "http://www.rootslabs.net", #VCard_UrlType_WORK)
VCard_SetPhoneNumber(@MyCard, "00 11 22 33 44", #VCard_PhoneType_WORK | #VCard_PhoneType_PAGER)
VCard_SetPhoneNumber(@MyCard, "55 66 77 88 99", #VCard_PhoneType_HOME | #VCard_PhoneType_VOICE)
VCard_SetPhoneNumber(@MyCard, "06 88 77 66 55", #VCard_PhoneType_CELL | #VCard_PhoneType_MSG | #VCard_PhoneType_PREF)
VCard_SetAdress(@MyCard, "","","2, rue des Etoiles","La Haye-Pesnel","Manche","50320","France", #VCard_AdressType_HOME)
VCard_SetAdress(@MyCard, "","","1, rue du Port","Caen","Calvados","14000","France", #VCard_AdressType_WORK)

VCard_SetVersion(@MyCard, #VCard_Version_2_1) : VCard_Write(@MyCard, "mycard_2.1.vcf")
VCard_SetVersion(@MyCard, #VCard_Version_3_0) : VCard_Write(@MyCard, "mycard_3_0.vcf")
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Post by Kwai chang caine »

Cool code
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Thanks, works fine :D
Not sure, but wouldn't the vcf file format also support informationen for doing reminders (meetings, birthdays etc.)?
User avatar
Progi1984
Addict
Addict
Posts: 806
Joined: Fri Feb 25, 2005 1:01 am
Location: France > Rennes
Contact:

Post by Progi1984 »

@Kwaï chang caïne ; Thanks :) !

@Michael Vogel : Thanks, too :) !

The VCard Format doesn't support this. You make a mistake : it's the ICS (ICal) File Format which make these.
KosterNET
User
User
Posts: 30
Joined: Tue Mar 22, 2016 10:08 pm

Re: Generate a VCard

Post by KosterNET »

Today (5 years later!) i was looking for this.. Thanks!!
Post Reply