1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
Imports System.Net
Imports SimpleDownloadFile
Public Class Form1
Dim Repertoire, Identifiant, Password, FichierIni As String
Dim Url1, Url2, Url3, Url4, Url5 As String
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As System.Text.StringBuilder, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Delegate Sub ChangeTextsSafe(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer)
Delegate Sub DownloadCompleteSafe(ByVal cancelled As Boolean)
Function EcrireINI(ByVal entete As String, ByVal variable As String, ByVal valeur As String, ByVal fichier As String)
On Error Resume Next
valeur = Trim(valeur)
WritePrivateProfileString(entete, variable, valeur, fichier)
End Function
Function LireINI(ByVal Entete As String, ByVal Variable As String, ByVal Ini As String) As String
Dim Deff As String = ""
Try
Dim StrBuild As New System.Text.StringBuilder(90)
Dim Ret As Integer = GetPrivateProfileString(Entete, Variable, Deff, StrBuild, 90, Ini)
Return Trim(StrBuild.ToString)
Catch
Return Trim(Deff)
End Try
End Function
Sub AfficherMasquerDownload(ByVal Download As Integer, ByVal Afficher As Integer)
Select Case Download
Case 1
Select Case Afficher
Case 0
TexteUrl1.Visible = False
TexteSize1.Visible = False
Size1.Visible = False
Index1.Visible = False
TexteDownload1.Visible = False
Down1.Visible = False
Pourcentage1.Visible = False
ProgressBar1.Visible = False
Case 1
TexteUrl1.Visible = True
TexteSize1.Visible = True
Size1.Visible = True
Index1.Visible = True
TexteDownload1.Visible = True
Down1.Visible = True
Pourcentage1.Visible = True
ProgressBar1.Visible = True
End Select
End Select
End Sub
Private Sub Download1()
On Error Resume Next
Dim Absent As Boolean
Dim Fichier As String = Nothing
Dim Rep As String = Nothing
ListView1.MultiSelect = True
ListView1.Focus()
For Compte = 0 To ListView1.Items.Count
ListView1.Items(Compte).Focused = True
ListView1.Items(Compte).Selected = True
Url1 = ListView1.SelectedItems.Item(Compte).Text '<=Modifier
If Url1 <> Url2 And Url1 <> Url3 And Url1 <> Url4 And Url1 <> Url5 Then
Dim pos As Integer = Url1.LastIndexOf("/")
Dim T = LireINI("Menu", Str(Compte + 1), FichierIni)
Dim W As String = T.Substring(Len(T) - 2)
If W = "*1" Then
Absent = False
Else
Absent = True
AfficherMasquerDownload(1, 1) '<=Modifier
ListView1.Items(Compte).ForeColor = Color.Red '<=Modifier
ListView1.Items(Compte).BackColor = Color.Yellow '<=Modifier
Index1.Text = Compte '<=Modifier(Label Index)
TexteUrl1.Text = Url1
ListView1.MultiSelect = False
Exit For
End If
End If
Next
If Absent = True Then
Rep = TexteUrl1.Text.Substring(7)
Rep = Repertoire & Microsoft.VisualBasic.Left(Rep, Rep.LastIndexOf("/")) & "\"
System.IO.Directory.CreateDirectory(Rep)
Fichier = TexteUrl1.Text.Substring(TexteUrl1.Text.LastIndexOf("/") + 1)
BackgroundWorker1.RunWorkerAsync(New Object() {Rep & Fichier})
End If
End Sub
Private Sub BackgroundWorker1_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim Fichier As String = e.Argument(0)
Dim theResponse As HttpWebResponse
Dim theRequest As HttpWebRequest
Dim Credit As System.Net.NetworkCredential = New System.Net.NetworkCredential(Identifiant, Password)
Try 'Checks if the file exist
' theRequest.Credentials = Credit
theRequest = WebRequest.Create(TexteUrl1.Text)
theResponse = theRequest.GetResponse
Catch ex As Exception
MessageBox.Show("An error occurred while downloading file. Possibe causes:" & ControlChars.CrLf & _
"1) File doesn't exist" & ControlChars.CrLf & _
"2) Remote server error", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete1)
Me.Invoke(cancelDelegate, True)
Exit Sub
End Try
Dim length As Long = theResponse.ContentLength 'Size of the response (in bytes)
Dim safedelegate As New ChangeTextsSafe(AddressOf ProgressDownload1)
Me.Invoke(safedelegate, length, 0, 0) 'Invoke the TreadsafeDelegate
Dim writeStream As New IO.FileStream(Fichier, IO.FileMode.Create)
Dim nRead As Integer
Dim readings As Integer = 0
Do
If BackgroundWorker1.CancellationPending Then 'If user abort download
Exit Do
End If
Dim readBytes(4095) As Byte
Dim bytesread As Integer = theResponse.GetResponseStream.Read(readBytes, 0, 4096)
nRead += bytesread
Dim percent As Short = (nRead * 100) / length '======>C'EST ICI QUE L'ERREUR APPARAIT
Me.Invoke(safedelegate, length, nRead, percent)
If bytesread = 0 Then Exit Do
writeStream.Write(readBytes, 0, bytesread)
readings += 1
Loop
theResponse.GetResponseStream.Close()
writeStream.Close()
If Me.BackgroundWorker1.CancellationPending Then
IO.File.Delete(Fichier)
Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete1)
Me.Invoke(cancelDelegate, True)
Exit Sub
End If
Dim completeDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete1)
Me.Invoke(completeDelegate, False)
End Sub
Public Sub ProgressDownload1(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer)
Size1.Text = Math.Round((length / 1024 / 1024), 2) & " MO"
Down1.Text = Math.Round((position / 1024 / 1024), 2) & " MO"
Pourcentage1.Text = ProgressBar1.Value & " %"
Me.ProgressBar1.Value = percent
End Sub
Public Sub DownloadComplete1(ByVal cancelled As Boolean)
TexteUrl1.Text = ""
Down1.Text = ""
Pourcentage1.Text = ""
ProgressBar1.Value = 0
AfficherMasquerDownload(1, 0)
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
AfficherMasquerDownload(1, 0)
Dim MyFolderBrowser As New System.Windows.Forms.FolderBrowserDialog
MyFolderBrowser.Description = "Selectionnez le répertoire de destination:"
MyFolderBrowser.SelectedPath = "E:\Video\"
Dim dlgResult As DialogResult = MyFolderBrowser.ShowDialog()
If dlgResult = Windows.Forms.DialogResult.OK Then
Repertoire = MyFolderBrowser.SelectedPath + "\"
End If
FichierIni = Repertoire & "Fichiers.ini"
Dim Nombre As Integer = Val(LireINI("Menu", "Nombre", FichierIni))
Label3.Text = Nombre
ListView1.Focus()
Dim Url1 As String
For Compte = 0 To Nombre - 1
Url1 = LireINI("Menu", Str(Compte + 1), FichierIni)
Dim pos As Integer = Url1.LastIndexOf("*")
If Microsoft.VisualBasic.Right(Url1, 2) = "*1" Then
If pos > 0 Then : Url1 = Microsoft.VisualBasic.Left(Url1, pos) : End If
ListView1.Items.Add(Url1)
Dim a As Integer = Val(Label2.Text) + 1
Label2.Text = a
ListView1.Items(Compte).Selected = True
ListView1.Items(Compte).ForeColor = Color.Lime
Else
ListView1.Items.Add(Url1)
End If
Next
If ListView1.Items.Count > 0 Then
ListView1.MultiSelect = False
ListView1.Items(0).Focused = True
ListView1.Items(0).Selected = True
End If
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Download1()
End Sub
End Class |
Erreur download fichier
Répondre avec citation
Partager