Vcardparser

Description

Ce bout de code naquit a l'issue de l'un de mes projets : "jobexftp" sur sourceforge.net, j'ai eut besoin de ça car par IRMC je recupére un fichier pb.vcf qui contient tout les contacts de mon téléphone portable.
Donc ce code sert a ouvrir ce fameux fichier puis le spliter Vcard par Vcard et si la Vcard a une photo encodé en Base64 je decode la jpg, ensuite je stocke tout dans le repertoire choisit.

Source / Exemple :


'Il faut un projet standard (exe VB) avec une Form1
'un bouton appeler BtnOpen
'un openfile dialogue appeler : OpenFileDialog1
'un FolderBrowser dialogue appeler : FolderBrowserDialog1

Public Class Form1
    Dim Vcard() As String
    Dim Champs() As String
    Private Sub BtnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOpen.Click
        Dim Reponse As DialogResult = Me.OpenFileDialog1.ShowDialog()
        Dim Reponse2 As DialogResult = Me.FolderBrowserDialog1.ShowDialog()
        If Reponse = Windows.Forms.DialogResult.OK And Reponse2 = Windows.Forms.DialogResult.OK Then
            If My.Computer.FileSystem.DirectoryExists(Me.FolderBrowserDialog1.SelectedPath & "\VcardParse\") = False Then _
            My.Computer.FileSystem.CreateDirectory(Me.FolderBrowserDialog1.SelectedPath & "\VcardParse\")
            Dim TheFile As String = My.Computer.FileSystem.ReadAllText(Me.OpenFileDialog1.FileName, System.Text.Encoding.Default)
            Vcard = Split(TheFile, "BEGIN:VCARD")
            For i As Integer = 0 To Vcard.Length - 1
                Champs = Split(Vcard(i), ":")
                If Champs.LongLength < 2 Then GoTo Suivant
                Dim Name() As String = Split(Champs(2), vbCrLf)
                My.Computer.FileSystem.WriteAllText( _
                Me.FolderBrowserDialog1.SelectedPath & "\VcardParse\" & Name(0) & ".vcf", "BEGIN:VCARD" & Vcard(i), False)
                Dim IdxJpeg As Integer = -1
                For j As Integer = 0 To Champs.Length - 1
                    If j = Champs.Length - 1 Then Exit For
                    Dim Trouve As Boolean = Champs(j).Contains("PHOTO")
                    If Trouve = True Then
                        IdxJpeg = j + 1
                        Exit For
                    End If
                Next
                Dim byteArray2(9024) As Byte
                If IdxJpeg <> -1 Then
                    Dim Tmp As String = Champs(IdxJpeg).Replace(vbCrLf, "")
                    Dim charArray() As Char = Tmp.ToCharArray
                    byteArray2 = Convert.FromBase64CharArray(charArray, 0, charArray.LongLength - 3)
                    My.Computer.FileSystem.WriteAllBytes( _
                    Me.FolderBrowserDialog1.SelectedPath & "\VcardParse\" & Name(0) & ".jpg", byteArray2, False)
                End If
Suivant:
            Next
            MessageBox.Show("Terminé", "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End If
    End Sub
End Class

Codes Sources

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.