littleboy62

Untitled

Oct 10th, 2020
76
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Imports System.IO
  2. Imports System.Text.RegularExpressions
  3.  
  4. Public Class Form1
  5.  
  6.     Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  7.  
  8.         Dim acc = "https://www.leboncoin.fr/"
  9.         Dim lien = "https://www.leboncoin.fr/recherche/?text=vbnet"
  10.         Dim cible = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\MesAnnoncesLeboncoin[VB]"
  11.         If System.IO.Directory.Exists(cible) Then System.IO.Directory.Delete(cible, True)
  12.         ListView1.Items.Clear()
  13.  
  14.         Dim request As Net.HttpWebRequest = Net.WebRequest.Create(lien)
  15.         request.Accept = "*/*"
  16.         request.UserAgent = "Mozilla/5.0 (Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko"
  17.         request.Headers("Accept-Encoding") = "utf8"
  18.  
  19.         Dim response As Net.HttpWebResponse = request.GetResponse()
  20.         Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream())
  21.         Dim sourcecode = sr.ReadToEnd()
  22.  
  23.         Dim strRegex As String = "<?href\s*=\s*[""'].+?[""'][^>]*?"
  24.         Dim myRegex As New Regex(strRegex, RegexOptions.None)
  25.  
  26.         Dim NB As Integer = 0
  27.  
  28.         For Each myMatch As Match In myRegex.Matches(sourcecode)
  29.  
  30.             If myMatch.Success Then
  31.  
  32.                 Dim result = myMatch.Value
  33.                 Dim lien_a = acc & result.Remove(result.Length - 1, 1).Remove(0, 7)
  34.                 Dim ext = lien_a.Substring(lien_a.LastIndexOf("."))
  35.  
  36.                 If ext = ".htm/" Then
  37.                     Dim tmpdir = Path.GetTempPath
  38.                     Dim fcs = tmpdir & "codesource.txt"
  39.  
  40.                     Dim request2 As Net.HttpWebRequest = Net.WebRequest.Create(lien_a)
  41.                     request2.Accept = "*/*"
  42.                     request2.UserAgent = "Mozilla/5.0 (Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko"
  43.                     request2.Headers("Accept-Encoding") = "utf8"
  44.  
  45.                     Dim response2 As Net.HttpWebResponse = request2.GetResponse()
  46.                     Dim sr2 As System.IO.StreamReader = New System.IO.StreamReader(response2.GetResponseStream())
  47.                     Dim sourcecode2 = sr2.ReadToEnd()
  48.  
  49.                     Dim monstreamwriter As StreamWriter = New StreamWriter(fcs)
  50.                     monstreamwriter.WriteLine(sourcecode2)
  51.                     monstreamwriter.Close()
  52.  
  53.                     Dim fichierComplet As String = File.ReadAllText(fcs)
  54.                     Dim pattern As String = """subject"":""(?<sujet>.*)"",""body"":""(?<corps>.*)"",""ad_type""" 'le moteur de regex de .Net accpete les groupes avec des noms, ici "sujet" et "corps"
  55.  
  56.                     For Each m As Match In Regex.Matches(fichierComplet, pattern)
  57.  
  58.                         If m.Success Then
  59.  
  60.                             Dim titre = m.Groups("sujet").Value
  61.                             titre = titre.Replace("\" & Chr(34), Chr(34))
  62.                             titre = titre.Replace("\n", vbCrLf)
  63.                             titre = titre.Replace("\u002F", "/")
  64.                             titre = titre.Replace("\\", "\")
  65.  
  66.                             Dim titre_d = titre
  67.                             titre_d = titre_d.Replace("/", " ")
  68.                             titre_d = titre_d.Replace(":", " ")
  69.                             titre_d = titre_d.Replace("*", " ")
  70.                             titre_d = titre_d.Replace("?", " ")
  71.                             titre_d = titre_d.Replace(Chr(34), " ")
  72.                             titre_d = titre_d.Replace("<", " ")
  73.                             titre_d = titre_d.Replace(">", " ")
  74.                             titre_d = titre_d.Replace("|", " ")
  75.  
  76.                             Dim desc = m.Groups("corps").Value
  77.                             desc = desc.Replace("\" & Chr(34), Chr(34))
  78.                             desc = desc.Replace("\n", vbCrLf)
  79.                             desc = desc.Replace("\u002F", "/")
  80.                             desc = desc.Replace("\\", "\")
  81.  
  82.                             Directory.CreateDirectory(cible)
  83.                             NB += 1
  84.                             Dim cible_a = cible & "\0" & NB & ". " & titre_d
  85.                             If Not System.IO.Directory.Exists(cible_a) Then Directory.CreateDirectory(cible_a)
  86.  
  87.                             Dim fichier_annonce = cible_a & "\annonce.txt"
  88.                             Dim fichier_titre = cible_a & "\titre.txt"
  89.  
  90.                             Dim monstreamwriter2 As StreamWriter = New StreamWriter(fichier_annonce)
  91.                             Dim monstreamwriter3 As StreamWriter = New StreamWriter(fichier_titre)
  92.                             monstreamwriter2.WriteLine(desc)
  93.                             monstreamwriter3.WriteLine(titre)
  94.                             monstreamwriter2.Close()
  95.                             monstreamwriter3.Close()
  96.  
  97.                             Dim item = ListView1.Items.Add("0" & NB)
  98.                             item.SubItems.Add(titre)
  99.                             item.SubItems.Add(desc)
  100.  
  101.                         End If
  102.                     Next
  103.  
  104.                     If File.Exists(fcs) Then System.IO.File.Delete(fcs)
  105.  
  106.                 End If
  107.             End If
  108.         Next
  109.  
  110.         Dim dir As New IO.DirectoryInfo(cible)
  111.         If dir.Exists Then Process.Start("explorer.exe", cible)
  112.  
  113.     End Sub
  114.  
  115.     Private Sub ListView1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs)
  116.  
  117.         If ListView1.SelectedItems.Count > 0 Then
  118.             Dim lvi As ListViewItem = ListView1.SelectedItems(0)
  119.             Dim text = lvi.SubItems(2).Text
  120.             Clipboard.SetDataObject(text)
  121.             'MsgBox(text)
  122.         End If
  123.  
  124.     End Sub
  125.  
  126. End Class
RAW Paste Data