Bonsoir dava n°l43,
Contents de t'avoir été utile, voici le code au complet cette fois (suite après) :
'
' aide vbnet form3 appel de forums
Option Explicit On
Public Class Form3
Dim liens As String
Sub Form3_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Top = Form1.Top + 40
Me.Left = Form1.Left + 30
Call lit()
End Sub
Sub AideToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AideToolStripMenuItem.Click
Dim m As String
Dim s As String = vbLf
m = "Aide" & s & s
m m & "Appeler un forum Double-cliquer sur le lien" & s & s
m m & "Supprimer un lien (Sélectionner la ligne préalablement)" & s & s
m = m & "Fichier à sauvegarder : vbnetAideLiens.txt" & s
MsgBox(m, vbInformation)
End Sub
Sub AjouterUnLienToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AjouterUnLienToolStripMenuItem.Click
Dim r As String
Dim er As Byte = 1
Dim i As Integer
r = InputBox("Saisir le nouveau lien ? ")
r = Trim(r)
If r = "" Then Exit Sub
r = LCase(r)
If Len(r) < 12 Then GoTo erreur
er = 2
If Mid(r, 1, 7) <> "http://" Then GoTo erreur
er = 3
i = InStr(1, r, ".", 1)
If i = 0 Then GoTo erreur
er = 4
For i = 0 To ListBox1.Items.Count - 1
If r = ListBox1.Items(i) Then GoTo erreur
Next i
ListBox1.Items.Add(r)
Call ecrit()
Call lit()
Exit Sub
erreur:
r = "ERREUR DE SAISIE" & vbLf & vbLf
Select Case er
Case 1 : r = r & "Lien trop court"
Case 2 : r = r & "Début de lien non conforme"
Case 3 : r = r & "Fin de lien sans domaine"
Case 4 : r = r & "Lien déjà existant"
End Select
MsgBox(r & vbLf, vbExclamation)
End Sub
Sub lit()
Dim ligne As String
Dim i As Integer
Try
ListBox1.Items.Clear()
ListBox2.Items.Clear()
ListBox3.Items.Clear()
Dim p As New System.IO.StreamReader(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
While p.Peek() >= 0
ligne = p.ReadLine()
If Mid(ligne, 1, 7) = "http://" Then
ListBox2.Items.Add(ligne)
Else
ListBox3.Items.Add(ligne)
End If
End While
p.Close()
Catch ex As Exception
Dim p1 As New System.IO.StreamWriter(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
p1.Close()
End Try
For i = 0 To ListBox2.Items.Count - 1
ListBox1.Items.Add(ListBox2.Items(i))
Next i
Dim p2 As New System.IO.StreamWriter(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
For i = 0 To ListBox2.Items.Count - 1
p2.WriteLine(ListBox2.Items(i))
Next i
For i = 0 To ListBox3.Items.Count - 1
p2.WriteLine(ListBox3.Items(i))
Next i
p2.Close()
Call nombreDeLiens()
End Sub
Sub ecrit()
Dim p As New System.IO.StreamWriter(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
For i = 0 To ListBox1.Items.Count - 1
p.WriteLine(ListBox1.Items(i))
Next i
For i = 0 To ListBox3.Items.Count - 1
p.WriteLine(ListBox3.Items(i))
Next i
p.Close()
End Sub
Sub nombreDeLiens()
liens "Nombre de liens " & ListBox1.Items.Count
If ListBox1.Items.Count < 2 Then liens "Nombre de lien " & ListBox1.Items.Count
NombreDeLiensToolStripMenuItem.Text = liens
End Sub
Sub SupprimerLeLienToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SupprimerLeLienToolStripMenuItem.Click
Dim r As Integer
If ListBox1.Items.Count < 1 Or ListBox1.SelectedIndex < 0 Then Exit Sub
r = MsgBox("Supprimer : " & vbLf & vbLf & ListBox1.Items(ListBox1.SelectedIndex), vbQuestion + vbYesNo + vbDefaultButton2)
If r <> vbYes Then Exit Sub
ListBox1.Items.RemoveAt(ListBox1.SelectedIndex)
Call ecrit()
Call lit()
End Sub
Sub ListBox1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.DoubleClick
If ListBox1.Items.Count < 1 Then Exit Sub
Try
Process.Start(ListBox1.Items(ListBox1.SelectedIndex))
Catch ex As Exception
MsgBox("Impossible d'ouvrir le site ", vbExclamation,
My.Application.Info.ProductName)
End Try
End Sub
End Class
-----------------
'
' aide vbnet form4 envoi mails
Option Explicit On
Public Class Form4
Dim liens As String
Sub Form4_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Top = Form1.Top + 40
Me.Left = Form1.Left + 30
Call lit()
End Sub
Sub AideToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AideToolStripMenuItem1.Click
Dim m As String
Dim s As String = vbLf
m = "Aide" & s & s
m m & "Ecrire un mail Double-cliquer sur le lien" & s & s
m m & "Supprimer une adresse (Sélectionner la ligne préalablement)" & s & s
m = m & "Fichier à sauvegarder : vbnetAideLiens.txt" & s
MsgBox(m, vbInformation)
End Sub
Sub AjouterUneAdresseToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AjouterUneAdresseToolStripMenuItem.Click
Dim r As String
Dim er As Byte = 1
Dim i As Integer
r = InputBox("Saisir la nouvelle adresse ? ")
r = Trim(r)
If r = "" Then Exit Sub
r = LCase(r)
If Len(r) < 8 Then GoTo erreur
er = 2
i = InStr(1, r, "@", 1)
If i = 0 Then GoTo erreur
er = 3
i = InStr(1, r, ".", 1)
If i = 0 Then GoTo erreur
er = 4
For i = 0 To ListBox1.Items.Count - 1
If r = ListBox1.Items(i) Then GoTo erreur
Next i
ListBox1.Items.Add(r)
Call ecrit()
Call lit()
Exit Sub
erreur:
r = "ERREUR DE SAISIE" & vbLf & vbLf
Select Case er
Case 1 : r = r & "Adresse trop courte"
Case 2 : r = r & "Adresse sans arobase"
Case 3 : r = r & "Adresse sans domaine"
Case 4 : r = r & "Adresse déjà existante"
End Select
MsgBox(r & vbLf, vbExclamation)
End Sub
Sub lit()
Dim ligne As String
Dim i As Integer
Try
ListBox1.Items.Clear()
ListBox2.Items.Clear()
ListBox3.Items.Clear()
Dim p As New System.IO.StreamReader(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
While p.Peek() >= 0
ligne = p.ReadLine()
If Mid(ligne, 1, 7) = "http://" Then
ListBox2.Items.Add(ligne)
Else
ListBox3.Items.Add(ligne)
End If
End While
p.Close()
Catch ex As Exception
Dim p1 As New System.IO.StreamWriter(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
p1.Close()
End Try
For i = 0 To ListBox3.Items.Count - 1
ListBox1.Items.Add(ListBox3.Items(i))
Next i
Dim p2 As New System.IO.StreamWriter(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
For i = 0 To ListBox2.Items.Count - 1 ' classement dans fichier par la les listes
p2.WriteLine(ListBox2.Items(i))
Next i
For i = 0 To ListBox3.Items.Count - 1
p2.WriteLine(ListBox3.Items(i))
Next i
p2.Close()
Call nombreDadresses()
End Sub
Sub ecrit()
Dim p As New System.IO.StreamWriter(CStr(My.Application.Info.DirectoryPath & "\vbnetAideLiens.txt"))
For i = 0 To ListBox2.Items.Count - 1 ' liens
p.WriteLine(ListBox2.Items(i))
Next i
For i = 0 To ListBox1.Items.Count - 1 ' adresses
p.WriteLine(ListBox1.Items(i))
Next i
p.Close()
End Sub
Sub nombreDadresses()
liens "Nombre d'adresses " & ListBox1.Items.Count
If ListBox1.Items.Count < 2 Then liens "Nombre d'adresse " & ListBox1.Items.Count
NombreDadressesToolStripMenuItem.Text = liens
End Sub
Sub SupprimerUneAdresseToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SupprimerUneAdresseToolStripMenuItem.Click
Dim r As Integer
If ListBox1.Items.Count < 1 Or ListBox1.SelectedIndex < 0 Then Exit Sub
r = MsgBox("Supprimer : " & vbLf & vbLf & ListBox1.Items(ListBox1.SelectedIndex), vbQuestion + vbYesNo + vbDefaultButton2)
If r <> vbYes Then Exit Sub
ListBox1.Items.RemoveAt(ListBox1.SelectedIndex)
Call ecrit()
Call lit()
End Sub
Sub ListBox1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.DoubleClick
If ListBox1.Items.Count < 1 Then Exit Sub
Dim dest As String = ListBox1.Items(ListBox1.SelectedIndex)
Try
System.Diagnostics.Process.Start("mailto:" & dest)
Catch ex As Exception
MsgBox("Impossible d'ouvrir le gestionnaire de Mails ", vbExclamation,
My.Application.Info.ProductName)
End Try
End Sub
End Class
----------- suite -------------
Ça donne une idée sur la possibilité de faire des enregistrement en rapport avec le webBrowser, toutefois si on veux faire beaucoup de dossiers pour classer les rubrique, voire à en rajouter, il faut sans doute rajouter en fin de ligne de list (invisible), le classement, et ensuite on peut déployer par exemple dans un combo les différentes rubriques, puis selon le choix afficher la liste voulue (son contenu), mais ça dépasse mon code qui n'est pas fait pour ça.
Au plaisir, cordialement, Joe.