It is currently Sun Nov 18, 2018 2:45 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 5 posts ] 
Author Message
 Post subject: Generate a VCard
PostPosted: Wed Aug 26, 2009 1:02 pm 
Offline
Addict
Addict
User avatar

Joined: Fri Feb 25, 2005 1:01 am
Posts: 806
Location: France > Rennes
This a toolset of functions for generating easily a VCard.

Manage the format VCard 2.1 & 3.0.

VCard : Wikipedia

Code:
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")


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Aug 29, 2009 8:19 am 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4309
Location: Lyon - France
Cool code
Thanks for sharing 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Aug 29, 2009 10:34 am 
Offline
Addict
Addict
User avatar

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2333
Thanks, works fine :D
Not sure, but wouldn't the vcf file format also support informationen for doing reminders (meetings, birthdays etc.)?


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Aug 29, 2009 10:55 am 
Offline
Addict
Addict
User avatar

Joined: Fri Feb 25, 2005 1:01 am
Posts: 806
Location: France > Rennes
@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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Generate a VCard
PostPosted: Fri Sep 14, 2018 1:35 pm 
Offline
New User
New User

Joined: Tue Mar 22, 2016 10:08 pm
Posts: 4
Today (5 years later!) i was looking for this.. Thanks!!


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 5 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 9 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye