Rechercher dans ce blog

lundi 15 mars 2021

Download Mutiples Files

 Bonjour, Voici comment télécharger multiples fichiers.

voici en image Téléchargement en Cours :

 

Voici en image Vérification des données :


 

Voici en Image Enregistrement :

 
 
Voici le code vb.net :

Imports System.ComponentModel
Imports System.IO
Imports System.Net
Imports System.Text.RegularExpressions
Imports System.Threading

Public Class Form1

    Dim URL As String = "https://archive.org/download/WiiWareCollectionByGhostware"
    Dim WithEvents wc As New WebClient
    Dim htmlContent As String = Nothing
    Dim filename As String = Nothing
    Dim arrays As Array
    Dim SW As Stopwatch
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim folder As New FolderBrowserDialog With {
        .Description = "Veuillez selectionner un dossier !",
        .RootFolder = Environment.SpecialFolder.Desktop,
        .ShowNewFolderButton = True}
        If folder.ShowDialog = DialogResult.OK Then
            downloadmultiplefiles(URL, folder.SelectedPath)
        Else : Exit Sub
        End If
    End Sub

    Private Async Sub downloadmultiplefiles(AdressUrl As String, destination As String)
        Try
            htmlContent = Await wc.DownloadStringTaskAsync(AdressUrl)
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
        If htmlContent Is Nothing Then Return
        Dim count = 0
        Try
            Dim RegexObj As New Regex("\<a href=(.*?)\>(.*\.wad)\<\/a\s*?\>", RegexOptions.IgnoreCase)
            Dim MatchResults As Match = RegexObj.Match(htmlContent)
            Dim matchCount = RegexObj.Matches(htmlContent).Count
            Me.Myprogressbar1.Maximum = matchCount
            While MatchResults.Success
                count += 1
                Me.Myprogressbar1.Value = count
                Dim fileUrl As String = Path.Combine(AdressUrl, MatchResults.Groups(2).Value)
                filename = MatchResults.Groups(2).Value
                Dim fileAndPath = Path.Combine(destination, filename)
                If Not My.Computer.FileSystem.FileExists(fileAndPath) Then
                    Me.Label1.Text = String.Format("Téléchargement de {0} fichiers sur {1}", count, matchCount)
                    Me.Label1.ForeColor = Color.White
                    SW = Stopwatch.StartNew
                    AddHandler wc.DownloadProgressChanged, AddressOf DownloadProgress
                    AddHandler wc.DownloadFileCompleted, AddressOf DownloadCompleted
                    Dim fileContent As String = Await wc.DownloadStringTaskAsync(fileUrl)
                    SetStatus(" Enregistrement en cours...")
                    Using writer As New StreamWriter(fileAndPath, False)
                        Await writer.WriteAsync(fileContent)
                    End Using
                    SW.Reset()
                Else
                    Me.Label1.Text = String.Format("Ignorer {0} fichiers sur {1}", count, matchCount)
                    Me.Label1.ForeColor = Color.White
                    Me.ToolStripStatusLabel1.Text = " Verification des Données..."
                    Me.ToolStripStatusLabel1.ForeColor = Color.Fuchsia
                    Await Task.Delay(50)
                End If
                MatchResults = MatchResults.NextMatch()
            End While
        Catch ex As ArgumentException
            MessageBox.Show(ex.Message)
        Finally
            Me.Label1.Text = "Tous les Téléchargement des fichiers sont terminé avec succès ! "
        End Try
    End Sub

    Private Sub DownloadCompleted(sender As Object, e As AsyncCompletedEventArgs)
        If e.Cancelled = True Then
            SetStatus(" Téléchargement annulé...")
        ElseIf e.Error IsNot Nothing Then
            SetStatus(" Erreur de Téléchargement...")
        ElseIf e.UserState IsNot Nothing Then
            SetStatus(" Téléchargement avec succès...")
        End If
    End Sub

    Private Sub DownloadProgress(sender As Object, e As DownloadProgressChangedEventArgs)
        Me.Myprogressbar2.Value = e.ProgressPercentage
        Dim value As Long = (e.BytesReceived / SW.ElapsedMilliseconds)
        SetStatus(String.Format("Téléchargement( {0} / {1} ) ", FormatFileSize(e.BytesReceived), FormatFileSize(e.TotalBytesToReceive)))
    End Sub

    Private Sub SetStatus(ByVal Status As String)
        If StatusStrip1.InvokeRequired Then
            StatusStrip1.Invoke(New Action(Of String)(AddressOf SetStatus), Status)
        Else
            ToolStripStatusLabel1.Text = filename & " " & Status
        End If
    End Sub

    Public Shared Function FormatFileSize(ByVal Taille As Long) As String
        If (Taille >= 1099511627776) Then
            Return String.Format("{0:N1} To", Taille / 1099511627776)
        ElseIf (Taille >= 1073741824) Then
            Return String.Format("{0:N1} Go", Taille / 1073741824)
        ElseIf (Taille >= 1048576) Then
            Return String.Format("{0:N1} Mo", Taille / 1048576)
        ElseIf (Taille >= 1024) Then
            Return String.Format("{0:N1} Ko", Taille / 1024)
        Else
            Return String.Format("{0} Octets", Taille)
        End If
    End Function

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
        If Not wc.IsBusy Then
            wc.CancelAsync()
            wc.Dispose()
        End If
    End Sub

    Private Sub ToolStripStatusLabel1_Paint(sender As Object, e As PaintEventArgs) Handles ToolStripStatusLabel1.Paint
        Dim lbl1 As ToolStripStatusLabel = CType(sender, ToolStripStatusLabel)
        DrawLabel(lbl1, e)
    End Sub

    Private Sub DrawLabel(lbl1 As ToolStripStatusLabel, e As PaintEventArgs)
        If lbl1.Text.Contains("wad") Then
            e.Graphics.Clear(lbl1.BackColor)
            Dim str1 = lbl1.Text.Substring(0, lbl1.Text.IndexOf("wad") + 3)
            e.Graphics.DrawString(str1, lbl1.Font, New SolidBrush(Color.Blue), New Point(0, 0), StringFormat.GenericTypographic)
            Dim str2 = lbl1.Text.Substring(str1.Length, lbl1.Text.Length - str1.Length)
            Dim textSize As SizeF = e.Graphics.MeasureString(str1, lbl1.Font, 0, StringFormat.GenericTypographic)
            e.Graphics.DrawString(str2, lbl1.Font, New SolidBrush(Color.Red), New Point(textSize.Width, 0), StringFormat.GenericTypographic)
        End If
    End Sub

    Private Sub Label1_Paint(sender As Object, e As PaintEventArgs) Handles Label1.Paint
        Dim lbl As Label = CType(sender, Label)
        DrawLabel2(lbl, e)
    End Sub

    Private Sub DrawLabel2(lbl As Label, e As PaintEventArgs)
        If lbl.Text.Contains("Téléchargement") Then
            e.Graphics.Clear(lbl.BackColor)
            arrays = Split(lbl.Text, " ")
            Dim str1 = lbl.Text.Substring(0, arrays(0).ToString.Length + arrays(1).ToString.Length + 1)
            e.Graphics.DrawString(str1, lbl.Font, New SolidBrush(Color.Blue), New Point(0, 0), StringFormat.GenericDefault)
            Dim str2 = lbl.Text.Substring(str1.Length, arrays(2).ToString.Length + 1)
            Dim textSize As SizeF = e.Graphics.MeasureString(str1, lbl.Font, 0, StringFormat.GenericDefault)
            e.Graphics.DrawString(str2, lbl.Font, New SolidBrush(Color.Red), New Point(textSize.Width - 6, 0), StringFormat.GenericDefault)
            Dim str3 = lbl.Text.Substring(str1.Length + str2.Length, arrays(3).ToString.Length + arrays(4).ToString.Length + 2)
            Dim textSize2 As SizeF = e.Graphics.MeasureString(str2, lbl.Font, 0, StringFormat.GenericDefault)
            e.Graphics.DrawString(str3, lbl.Font, New SolidBrush(Color.Blue), New Point(textSize2.Width + 102, 0), StringFormat.GenericDefault)
            Dim str4 = lbl.Text.Substring(str1.Length + str2.Length + str3.Length, arrays(5).ToString.Length + 1)
            Dim textSize3 As SizeF = e.Graphics.MeasureString(str3, lbl.Font, 0, StringFormat.GenericDefault)
            e.Graphics.DrawString(str4, lbl.Font, New SolidBrush(Color.Red), New Point(textSize2.Width + 168, 0), StringFormat.GenericDefault)
        ElseIf lbl.Text.Contains("Ignorer") Then
            e.Graphics.Clear(lbl.BackColor)
            arrays = Split(lbl.Text, " ")
            Dim str1 = lbl.Text.Substring(0, arrays(0).ToString.Length)
            e.Graphics.DrawString(str1, lbl.Font, New SolidBrush(Color.Blue), New Point(0, 0), StringFormat.GenericDefault)
            Dim str2 = lbl.Text.Substring(str1.Length, arrays(1).ToString.Length + 1)
            Dim textSize As SizeF = e.Graphics.MeasureString(str1, lbl.Font, 0, StringFormat.GenericDefault)
            e.Graphics.DrawString(str2, lbl.Font, New SolidBrush(Color.Red), New Point(textSize.Width - 5, 0), StringFormat.GenericDefault)
            Dim str3 = lbl.Text.Substring(str1.Length + str2.Length, arrays(2).ToString.Length + arrays(3).ToString.Length + 2)
            Dim textSize2 As SizeF = e.Graphics.MeasureString(str2, lbl.Font, 0, StringFormat.GenericDefault)
            e.Graphics.DrawString(str3, lbl.Font, New SolidBrush(Color.Blue), New Point(textSize2.Width + 39, 0), StringFormat.GenericDefault)
            Dim str4 = lbl.Text.Substring(str1.Length + str2.Length + str3.Length, arrays(4).ToString.Length + 1)
            Dim textSize3 As SizeF = e.Graphics.MeasureString(str3, lbl.Font, 0, StringFormat.GenericDefault)
            e.Graphics.DrawString(str4, lbl.Font, New SolidBrush(Color.Red), New Point(textSize2.Width + 105, 0), StringFormat.GenericDefault)
        End If
    End Sub
End Class

ajouter un class progressbar :

Imports System.ComponentModel

Public Class Myprogressbar
    Inherits ProgressBar

    Public Sub New()
        Me.SetStyle(ControlStyles.UserPaint, True)
        Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
    End Sub

    <EditorBrowsable(EditorBrowsableState.Always), Browsable(True)>
    Public Overrides Property Font() As Font
        Get
            Return MyBase.Font
        End Get
        Set(ByVal value As Font)
            MyBase.Font = value
        End Set
    End Property

    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        Dim g = e.Graphics
        Dim rect As Rectangle = Me.ClientRectangle
        Dim valueRange = ((Me.Value - Me.Minimum) / (Me.Maximum - Me.Minimum))
        rect.Width = CInt(rect.Width * valueRange)
        ProgressBarRenderer.DrawHorizontalBar(g, Me.DisplayRectangle)
        If Me.BackColor <> SystemColors.Control Then
            Using backColorBrush As New SolidBrush(Me.BackColor)
                g.FillRectangle(backColorBrush, New Rectangle(1, 1, Me.ClientRectangle.Width - 2, Me.ClientRectangle.Height - 2))
            End Using
        End If
        If rect.Width > 0 Then
            Dim valuFillRect = rect : valuFillRect.Inflate(-1, -1)
            ProgressBarRenderer.DrawHorizontalChunks(g, valuFillRect)
        End If
        Dim percntText = valueRange.ToString("P0")
        Using reg1 As New Region(rect)
            Using reg2 As New Region(Me.ClientRectangle)
                reg2.Exclude(reg1)
                Dim textsize As SizeF = g.MeasureString(percntText, Me.Font)
                Dim x As Single = (Me.ClientRectangle.Width - textsize.Width) / 2
                Dim y As Single = (Me.ClientRectangle.Height - textsize.Height) / 2
                g.Clip = reg1
                Dim invertedForeColor = -16777217 - (Me.ForeColor).ToArgb
                Using invertedBrush As New SolidBrush(Color.FromArgb(invertedForeColor))
                    g.DrawString(percntText, Me.Font, invertedBrush, x, y)
                End Using
                g.Clip = reg2
                Using foreColorBrush As New SolidBrush(Me.ForeColor)
                    g.DrawString(percntText, Me.Font, foreColorBrush, x, y)
                End Using
            End Using
        End Using
    End Sub
End Class

Voilà comment télécharger tous les fichiers par rapport un liens.Merci