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