Trieur de contacts msn/wlm

Télécharger le projet
Commenter

Description

Simple petit programme faite rapidement pour me permettre de trier mes contacts extrait d'un compte à un autre. Le trieur de Hotmail est bien plus pratique, mais très peu si on veut garder ces contacts sur ce compte...

Bref pour l'utiliser, vous vous devez(!!!) d'exporter vos contacts à partir d'HOTMAIL pour l'importer dans mon programme.

Source / Exemple : 


Imports System.IO
Imports System.Text.RegularExpressions

Public Class frmMain
    Dim TempListBox As ListBox
    Dim PremierFichier As Boolean = True
    Dim NomFicherImporter As String
    Const constPositionEmail1 As Integer = 46
    Const constPositionEmail2 As Integer = 49

    Private Sub btnChoisirFichier_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnChoisirFichier.Click
        'Selection de fichier :
        'Variables
        Dim poursuivre As Boolean = True
        If (PremierFichier = True) Then
            PremierFichier = False
        Else
            Dim reply As DialogResult = MessageBox.Show("La liste de vos contacts triées va être vidé, voulez-vous continuez?", "Vidange des listes", _
              MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)

            If reply = DialogResult.Yes Then
                lsContactImport.Items.Clear()
                lsok.Items.Clear()
                lsrefuser.Items.Clear()
                lsretri.Items.Clear()
            Else
                poursuivre = False
            End If

        End If

        If (poursuivre = True) Then
            Dim strUrlFichier As String = String.Empty

            'Ouverture de la fenêtre pour choisir un fichier
            Dim OpenFD As Integer = ofdFichier.ShowDialog()

            'Si un fichier est sélectionné
            If OpenFD <> DialogResult.Cancel Then
                strUrlFichier = ofdFichier.FileName
                If (ofdFichier.FileName.EndsWith(".csv") Or ofdFichier.FileName.EndsWith(".txt")) Then
                    If (strUrlFichier IsNot Nothing) Then
                        tbFicher.Text = strUrlFichier
                        lireContact(strUrlFichier)
                        NomFicherImporter = ""
                        Dim fnPeices() As String = ofdFichier.SafeFileName.ToString.Split(".")
                        Dim i As Integer = 0
                        Do While i < fnPeices.Count - 1
                            NomFicherImporter &= fnPeices(i) & "."
                            i += 1
                        Loop
                        NomFicherImporter = NomFicherImporter.Substring(0, NomFicherImporter.Length - 1)

                    End If
                Else
                    MsgBox("Format de fichier invalide")
                End If
            End If
        End If
    End Sub

    Sub lireContact(ByVal fichier As String)
        Try 'Ouverture de fichier = try...
            Dim stFichier As New StreamReader(fichier, System.Text.Encoding.ASCII) 'Flux pour lire le fichier
            Dim strSplitLine() As String
            Dim strLigne As String
            stFichier.BaseStream.Seek(0, SeekOrigin.Begin)
            stFichier.ReadLine() 'Simplement pour sauter la première ligne qui contient le titre des colones
            While stFichier.Peek() > -1
                Dim rep As String = stFichier.Peek
                strLigne = stFichier.ReadLine()
                strSplitLine = strLigne.Split(";")
                If (strSplitLine(constPositionEmail1) <> "") Then
                    strSplitLine(constPositionEmail1) = strSplitLine(constPositionEmail1).Substring(1, (strSplitLine(constPositionEmail1).ToString.Length - 2))
                End If
                If (strSplitLine(constPositionEmail2) <> "") Then
                    strSplitLine(constPositionEmail2) = strSplitLine(constPositionEmail2).Substring(1, (strSplitLine(constPositionEmail2).ToString.Length - 2))
                End If
                If (IsEmail(strSplitLine(constPositionEmail1))) Then
                    lsContactImport.Items.Add(strSplitLine(constPositionEmail1))
                Else
                    If (IsEmail(strSplitLine(constPositionEmail2))) Then
                        lsContactImport.Items.Add(strSplitLine(constPositionEmail2))
                    End If
                End If
            End While
            stFichier.Close()

        Catch ex As Exception
            MsgBox("Impossible de charger ce fichier!")
        End Try
    End Sub

    Function IsEmail(ByVal email As String) As Boolean
        Static emailExpression As New Regex("^[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})$")
        Return emailExpression.IsMatch(email)
    End Function

    Private Sub CacheIcon(ByVal lequel As String)
        Dim quel As Integer = CInt(lequel)
        pbOk.Enabled = True
        pbOk.Image = My.Resources.ok
        pbPasOk.Enabled = True
        pbPasOk.Image = My.Resources.pasok
        pbTri.Enabled = True
        pbTri.Image = My.Resources.tri

        If (quel = 0) Then
            pbOk.Enabled = False
            pbOk.Image = My.Resources.okgris
        End If
        If (quel = 1) Then
            pbPasOk.Enabled = False
            pbPasOk.Image = My.Resources.pasokgris
        End If
        If (quel = 2) Then
            pbTri.Enabled = False
            pbTri.Image = My.Resources.trigris
        End If
    End Sub

    Private Sub pbOk_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbTri.MouseEnter, pbPasOk.MouseEnter, pbOk.MouseEnter
        Dim TempPictureBox As PictureBox
        TempPictureBox = DirectCast(sender, PictureBox)
        TempPictureBox.BorderStyle = BorderStyle.FixedSingle
    End Sub

    Private Sub pbOk_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbTri.MouseLeave, pbPasOk.MouseLeave, pbOk.MouseLeave
        Dim TempPictureBox As PictureBox
        TempPictureBox = DirectCast(sender, PictureBox)
        TempPictureBox.BorderStyle = BorderStyle.None
    End Sub

    Private Sub pbOk_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbTri.MouseDown, pbPasOk.MouseDown, pbOk.MouseDown
        Dim TempPictureBox As PictureBox
        TempPictureBox = DirectCast(sender, PictureBox)
        TempPictureBox.BorderStyle = BorderStyle.Fixed3D
    End Sub

    Private Sub pbOk_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbTri.MouseUp, pbPasOk.MouseUp, pbOk.MouseUp
        Dim TempPictureBox As PictureBox
        TempPictureBox = DirectCast(sender, PictureBox)
        TempPictureBox.BorderStyle = BorderStyle.FixedSingle

        If (TempPictureBox.Tag = 0) Then
            ContactOk()
        End If
        If (TempPictureBox.Tag = 1) Then
            ContactPasOk()
        End If
        If (TempPictureBox.Tag = 2) Then
            ContactRetri()
        End If

    End Sub

    Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        TempListBox = lsok
      
    End Sub

    Private Sub lsretri_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lsretri.SelectedIndexChanged, lsrefuser.SelectedIndexChanged, lsok.SelectedIndexChanged, lsContactImport.SelectedIndexChanged
        If (TempListBox IsNot DirectCast(sender, ListBox)) Then
            If (TempListBox.SelectedItem <> "") Then
                TempListBox.SelectedIndex = -1
            End If
            TempListBox = DirectCast(sender, ListBox)
            CacheIcon(TempListBox.Tag)
        End If
    End Sub

    Private Sub ContactOk()
        If (TempListBox.SelectedItem <> "") Then
            lsok.Items.Add(TempListBox.SelectedItem)
            TempListBox.Items.RemoveAt(TempListBox.SelectedIndex)
            If (TempListBox.Items.Count > 0) Then
                TempListBox.SelectedIndex = 0
            End If
        End If

    End Sub

    Private Sub ContactPasOk()
        If (TempListBox.SelectedItem <> "") Then
            lsrefuser.Items.Add(TempListBox.SelectedItem)
            TempListBox.Items.RemoveAt(TempListBox.SelectedIndex)
            If (TempListBox.Items.Count > 0) Then
                TempListBox.SelectedIndex = 0
            End If
        End If

    End Sub

    Private Sub ContactRetri()
        If (TempListBox.SelectedItem <> "") Then
            lsretri.Items.Add(TempListBox.SelectedItem)
            TempListBox.Items.RemoveAt(TempListBox.SelectedIndex)
            If (TempListBox.Items.Count > 0) Then
                TempListBox.SelectedIndex = 0
            End If
        End If

    End Sub

  
    Private Sub btnretri_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnretri.Click, btnrefuser.Click, btnok.Click
        Dim TempBouton As Button
        TempBouton = DirectCast(sender, Button)

        

        EnregistrerListe(CInt(TempBouton.Tag))
    End Sub

    Private Sub EnregistrerListe(ByVal lequel As Integer)
        Dim typenom As String = ""
        If (lequel = 0) Then
            typenom = "ContactsAccepte"
        End If
        If (lequel = 1) Then
            typenom = "ContactsRefuse"
        End If
        If (lequel = 2) Then
            typenom = "ContactsARetrier"
        End If
        Dim extension As String = DateTime.Now.ToString.Replace(" ", "-")
        extension = extension.Replace(":", ".")
        Dim Dossier As String = System.Environment.GetFolderPath(System.Environment.SpecialFolder.MyDocuments) + "\listeemail\" + typenom
        Dim NomFichier As String = System.Environment.GetFolderPath(System.Environment.SpecialFolder.MyDocuments) + "\listeemail\" + typenom + "\" + NomFicherImporter + "-" + extension + ".txt"
        If (Not System.IO.Directory.Exists(Dossier)) Then
            System.IO.Directory.CreateDirectory(Dossier)
        End If

        Dim MonFlux As New System.IO.FileStream(NomFichier, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.None)
        Dim objWriter As New StreamWriter(MonFlux)
        objWriter.WriteLine("""Title"";""First Name"";""Middle Name"";""Last Name"";""Suffix"";""Company"";""Department"";""Job Title"";""Business Street"";""Business City"";""Business State"";""Business Postal Code"";""Business Country"";""Home Street"";""Home City"";""Home State"";""Home Postal Code"";""Home Country"";""Business Fax"";""Business Phone"";""Business Phone 2"";""Callback"";""Car Phone"";""Company Main Phone"";""Home Fax"";""Home Phone"";""Home Phone 2"";""ISDN"";""Mobile Phone"";""Other Fax"";""Other Phone"";""Pager"";""Primary Phone"";""Radio Phone"";""TTY/TDD Phone"";""Telex"";""Account"";""Anniversary"";""Assistant's Name"";""Billing Information"";""Birthday"";""Business Address PO Box"";""Categories"";""Children"";""Company Yomi"";""Directory Server"";""E-mail Address"";""E-mail Type"";""E-mail Display Name"";""E-mail 2 Address"";""E-mail 2 Type"";""E-mail 2 Display Name"";""E-mail 3 Address"";""E-mail 3 Type"";""E-mail 3 Display Name"";""Gender"";""Given Yomi"";""Government ID Number"";""Hobby"";""Home Address PO Box"";""Initials"";""Internet Free Busy"";""Keywords"";""Language"";""Location"";""Manager's Name"";""Mileage"";""Notes"";""Office Location"";""Organizational ID Number"";""Other Address PO Box"";""Priority"";""Private"";""Profession"";""Referred By"";""Sensitivity"";""Spouse"";""Surname Yomi"";""User 1"";""User 2"";""Web Page""")
        If (lequel = 0) Then
            For Each c In lsok.Items
                If (c.ToString.Length > 1) Then
                    objWriter.WriteLine(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;""" + c.ToString + """;""SMTP"";;""" + c.ToString + """;""SMTP"";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
                End If
            Next
        End If
        objWriter.Flush()
        objWriter.Close()
        MonFlux.Close()
        MsgBox("Votre liste de contacts à été enregisté.")
        Process.Start("notepad", NomFichier)
    End Sub
End Class

Conclusion :


Programme très basic!

P.S. lieux d'enregistrement des fichiers est dans le dossier listeemail qui se trouve dans le repertoire Mes documents...

Ah oui dsl il manque de commentaire...
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (ircland)