PDA

Показать полную графическую версию : [решено] Помогите исправить.


Страниц : [1] 2

by_gangster
13-10-2013, 14:56
В общем имеется исходники программы для вижуала и сама программа, ничего особенного в этой программе нет она просто скачивает файл и ложит его там же где и сама программа. При скачивании она жрёт столько ОЗУ сколько весит сам файл который скачивается в этом и проблема. Можно ли как-нибудь сделать так что бы файл не помещался в память а сразу же скачивался и был рядом с программой ? Подскажите в какую сторону копать ?

Iska
13-10-2013, 15:12
by_gangster, разговор ни о чём. Приведите код.

by_gangster
13-10-2013, 15:56
Iska, Извините вот InternetControl.vb. Я в программировании пока не очень силён прошу строго не судить..

Public Class InternetControl
Implements IInternetEvents

#Region "Internet"
Public myHttpWebRequest As Net.HttpWebRequest
Public myHttpWebResponse As Net.HttpWebResponse
Dim WithEvents Tmr As New System.Windows.Forms.Timer()

Public Event SendingQuery(ByVal sender As Object, ByRef e As System.ComponentModel.CancelEventArgs) Implements IInternetEvents.SendingQuery
Public Event SentQuery(ByVal sender As Object, ByVal e As EventArgs) Implements IInternetEvents.SentQuery
Public Event ReceivedResponse(ByVal sender As Object, ByVal e As EventArgs) Implements IInternetEvents.ReceivedResponse
Public Event ReceiveProgress(ByVal sender As Object, ByVal e As WinsockReceiveProgressEventArgs) Implements IInternetEvents.ReceiveProgress
Public Event DownloadCancelled(ByVal sender As Object, ByVal e As EventArgs) Implements IInternetEvents.DownloadCancelled
Dim KpAlv As Boolean
Property KeepAlive() As Boolean
Get
Return KpAlv
End Get
Set(ByVal value As Boolean)
KpAlv = value
End Set
End Property
Dim AlAuRd As Boolean
Property AllowAutoRedirect() As Boolean
Get
Return AlAuRd
End Get
Set(ByVal value As Boolean)
AlAuRd = value
End Set
End Property
Dim UrTG As String = SiteAlg
Property UrlToGo() As String
Get
Return UrTG
End Get
Set(ByVal value As String)
UrTG = value
TextBox1.Text = value
End Set
End Property
Dim UrlRf As String
Property UrlReferer() As String
Get
Return UrlRf
End Get
Set(ByVal value As String)
UrlRf = value
End Set
End Property
Dim UrlRdr As String
Property UrlRedirect() As String
Get
Return UrlRdr
End Get
Set(ByVal value As String)
UrlRdr = value
TextBox4.Text = value
End Set
End Property
Dim UsAg As String = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; MyIE2;"
Property UserAgent() As String
Get
Return UsAg
End Get
Set(ByVal value As String)
UsAg = value
End Set
End Property
Dim Acpt As String = "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*"
Property Accept() As String
Get
Return Acpt
End Get
Set(ByVal value As String)
Acpt = value
End Set
End Property
Dim PrxIp As String = ""
Property ProxyIp() As String
Get
Return PrxIp
End Get
Set(ByVal value As String)
PrxIp = value
End Set
End Property
Dim PrxPt As String = ""
Property ProxyPort() As String
Get
Return PrxPt
End Get
Set(ByVal value As String)
PrxPt = value
End Set
End Property
Dim Encod As String = "windows-1251"
Property EncodingPage() As String
Get
Return Encod
End Get
Set(ByVal value As String)
Encod = value
End Set
End Property
Dim LngP As String = ""
Property LanguagePage() As String
Get
Return LngP
End Get
Set(ByVal value As String)
LngP = value
End Set
End Property
Dim Prms As String = ""
Property ContentQuery() As String
Get
Return Prms
End Get
Set(ByVal value As String)
Prms = value
TextBox2.Text = value
End Set
End Property
Dim ConTyp As String = "application/x-www-form-urlencoded"
Property ContentType() As String
Get
Return ConTyp
End Get
Set(ByVal value As String)
ConTyp = value
ComboBox1.Text = value
End Set
End Property
Dim ConLen As Integer = 0
Property ContentLength() As String
Get
Return ConLen
End Get
Set(ByVal value As String)
ConLen = value
End Set
End Property
Dim Mtd As String = "POST"
Property HttpMethod() As String
Get
Return Mtd
End Get
Set(ByVal value As String)
Mtd = value
ComboBox2.Text = value
End Set
End Property
Dim ResCd As String = ""
Property ResultCode() As String
Get
Return ResCd
End Get
Set(ByVal value As String)
ResCd = value
End Set
End Property
Dim tmOut As String = "10000"
Property TimeOut() As String
Get
Return tmOut
End Get
Set(ByVal value As String)
tmOut = value
End Set
End Property
Dim tmd As String = "0"
Property TimeDelay() As String
Get
Return tmd
End Get
Set(ByVal value As String)
If value > 0 Then
tmd = value : Tmr.Interval = value
Else
tmd = 0 : Tmr.Interval = 1
End If
End Set
End Property
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Tmr.Tick
Tmr.Stop()
End Sub

Dim Hdrs As String = ""
Property Headers() As String
Get
Return Hdrs
End Get
Set(ByVal value As String)
Hdrs = value
End Set
End Property
Function GetHeadersToMy(ByVal hs As Net.WebHeaderCollection) As String
Dim i As Integer, str As String = ""
For i = 0 To hs.Keys.Count - 1
str &= hs.AllKeys(i) & ":" & hs.Item(i) & vbCrLf
Next
Return str
End Function
Dim Cooc As String = ""
Property CookiesQueries() As String
Get
Return Cooc
End Get
Set(ByVal value As String)
Cooc = value
End Set
End Property
Function GetCookiesToMy(ByVal cc As Net.CookieCollection) As String
Dim i As Integer, str As String = ""
For i = 0 To cc.Count - 1
str &= cc.Item(i).Name & "=" & cc.Item(i).Value & vbCrLf
str &= "Создан" & ":" & cc.Item(i).TimeStamp.ToString() & "; "
If cc.Item(i).Expires.Ticks = 0 Then
str &= "Уничтожится" & ":" & "не указано" & "; "
Else
str &= "Уничтожится" & ":" & cc.Item(i).Expires.ToString() & "; "
End If
str &= "Путь" & ":" & cc.Item(i).Path & "; "
str &= "Домен" & ":" & cc.Item(i).Domain & "; "
str &= "HttpOnly" & ":" & cc.Item(i).HttpOnly & "; " & vbCrLf
Next
Return str
End Function
Function GetCookiesFromoMy(ByVal str As String) As Net.CookieCollection
Dim i, j As Integer, cc As New Net.CookieCollection()
Dim ch() As String = str.Split(New String() {vbCrLf}, StringSplitOptions.RemoveEmptyEntries)
If ch.Length < 2 Then Return cc
For i = 0 To ch.Length - 1 Step 2
Dim co As New Net.Cookie(ch(i).Split("=")(0).Trim, ch(i).Substring(ch(i).IndexOf("=") + 1).Trim)
Dim cParams() As String = ch(i + 1).Split(New String() {"; ", ";"}, StringSplitOptions.RemoveEmptyEntries)
' задаем основные параметры из заголовка
For j = 0 To cParams.Length - 1
Dim prm As String = cParams(j).Substring(cParams(j).IndexOf(":") + 1)
If cParams(j).IndexOf("Уничтожится" & ":") = 0 Then
If prm.ToUpper <> "не указано".ToUpper Then co.Expires = prm
ElseIf cParams(j).IndexOf("Путь" & ":") = 0 Then
co.Path = prm
ElseIf cParams(j).IndexOf("Домен" & ":") = 0 Then
co.Domain = prm
ElseIf cParams(j).IndexOf("HttpOnly" & ":") = 0 Then
co.HttpOnly = prm
End If
Next
cc.Add(co)
Next
Return cc
End Function
Dim src As String
Public Property ResultQuery() As String
Get
Return src
End Get
Set(ByVal value As String)
src = value
TextBox3.Text = value
End Set
End Property

Dim buf As Integer = 50000
Public Property BufferSize() As Integer
Get
Return buf
End Get
Set(ByVal value As Integer)
buf = value
End Set
End Property
Dim PathForDownl As String
Public Property PathForDownloads() As String
Get
Return PathForDownl
End Get
Set(ByVal value As String)
PathForDownl = value
End Set
End Property
Dim FileDnlng As Boolean = False
Public Property FileDownloading() As Boolean
Get
Return FileDnlng
End Get
Set(ByVal value As Boolean)
FileDnlng = value
If value = False Then DownloadPause = False
End Set
End Property
Dim DnlngPs As Boolean = False
Public Property DownloadPause() As Boolean
Get
Return DnlngPs
End Get
Set(ByVal value As Boolean)
DnlngPs = value
End Set
End Property
Public Property CheckConnect() As Boolean
Get
Dim oldUrl As String = UrlToGo
Dim oldMet As String = HttpMethod
Try
UrlToGo = "http://google.com"
HttpMethod = "GET"
PeredQuery()
UrlToGo = oldUrl
HttpMethod = oldMet
System.Windows.Forms.Application.DoEvents()
myHttpWebResponse = myHttpWebRequest.GetResponse()
Return True
Catch ex As Exception
UrlToGo = oldUrl
HttpMethod = oldMet
Return False
End Try
End Get
Set(ByVal value As Boolean)
End Set
End Property


' ПОШЛИ МЕТОДЫ
Sub DownloadCancel()
FileDownloading = False
End Sub
Sub DownloadResume()
DownloadPause = False
End Sub
Public Sub ClearCookies()
CookiesQueries = ""
End Sub

' Задержка
Sub DelayQuery()
If TimeDelay <> 0 Then
Tmr.Start()
While Tmr.Enabled : System.Windows.Forms.Application.DoEvents() : End While
End If
End Sub
' Объединения ссылок. Например, http://job.yuga.ru/addresume/index.shtml и /img/spamfilter/4tynk3lh143zogpdhkxpyc956imq06ol.gif
Function ConnectUris(ByVal BeginUri As String, ByVal EndUri As String) As String
If EndUri = "" Then Return ""
If EndUri.IndexOf("http") <> 0 Then
If BeginUri <> "" Then
Dim ur As New Uri(BeginUri)
If EndUri.IndexOf("/") = 0 Then
EndUri = ur.Scheme & "://" & ur.Host & EndUri
Else
Dim ind As Integer = ur.AbsolutePath.LastIndexOf("/")
If ind <> -1 Then
EndUri = ur.Scheme & "://" & ur.Host & ur.AbsolutePath.Substring(0, ind + 1) & EndUri
End If
End If
End If
End If
Return EndUri
End Function

' ПОЛУЧИТЬ КОД СТРАНИЦЫ
Function GetSourceCodePage(ByVal page As String) As String
UrlToGo = page
If UrlToGo = "" Then Return ""

' Выполнить запрос
ExecuteQuery()

myHttpWebResponse.Close()
DelayQuery()

Return ResultQuery
End Function

Dim thr As Threading.Thread
Dim FlName As String
' СКАЧАТЬ ФАЙЛ
Sub DownloadFile(ByVal fl As String, ByVal WaitForDownload As Boolean)

If FileDownloading Then
MsgBox(trans("Уже идет скачивание файла. Сначала дождитесь его завершения.")) : Exit Sub
End If

' Вызов события ОтправляетсяЗапроса
Dim e As New System.ComponentModel.CancelEventArgs()
RaiseEvent SendingQuery(Me, e)
If e.Cancel Then Exit Sub

' Стандартизировать ссылку. Например, если рисунок задан относительно, а не абсолютно
fl = ConnectUris(UrlToGo, fl.Trim)
UrlToGo = fl

Dim oldMet As String = Me.HttpMethod
HttpMethod = "GET"

' Выполнить запрос
ExecuteQuery(False)

HttpMethod = oldMet

' Получить собственно файл
If PathForDownl = "" Then
FlName = IO.Path.GetTempPath & IO.Path.GetFileName(fl)
Else
PathForDownloads = GetMaxPath(PathForDownloads)
If IO.Directory.Exists(PathForDownloads) = False Then
IO.Directory.CreateDirectory(PathForDownloads)
End If
FlName = PathForDownloads & "\" & IO.Path.GetFileName(fl)
End If
If IO.Path.GetFileName(FlName).Split(IO.Path.GetInvalidFileNameChars).Length > 1 Then
FlName = IO.Path.GetTempPath & GetUIN() & ".tmp"
End If

' Получить асинхронно
If WaitForDownload = False Then
thr = New Threading.Thread(AddressOf AsyncDownload)
thr.Start(myHttpWebResponse.GetResponseStream)

' Получить синхронно
Else
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(myHttpWebResponse.GetResponseStream)
Dim all As New System.Collections.Generic.List(Of Byte)
Do
' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do
all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)
Loop
DownloadSuccess(all)
End If
End Sub
' Функция реализующая поток, который скачивайт файл порциями BufferSize
Sub AsyncDownload(ByVal stream As Object)
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(stream)
Dim all As New System.Collections.Generic.List(Of Byte)
Do
' Всякие Прерывания и Паузы потока
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
While DownloadPause
System.Windows.Forms.Application.DoEvents()
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
End While

' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do
all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)
Loop
DownloadSuccess(all)
End Sub
Delegate Sub dDownloadSuccess(ByVal lst As System.Collections.Generic.List(Of Byte))
Sub DownloadSuccess(ByVal lst As System.Collections.Generic.List(Of Byte))
If Me.InvokeRequired Then
Dim d As New dDownloadSuccess(AddressOf DownloadSuccess)
Me.Invoke(d, New Object() {lst})
Else
' Собственно завершение загрузки
IO.File.WriteAllBytes(FlName, lst.ToArray)
ResultQuery = FlName

' Снимаем синхблок
FileDownloading = False

' Вызов события ПолученОтвет
RaiseEvent ReceivedResponse(Me, New EventArgs)
End If
End Sub
Delegate Sub dReceiveProgressInvoke(ByVal count As Long)
Sub ReceiveProgressInvoke(ByVal count As Long)
If Me.InvokeRequired Then
Dim d As New dReceiveProgressInvoke(AddressOf ReceiveProgressInvoke)
Me.Invoke(d, New Object() {count})
Else
' Вызов события Идет прием данных
RaiseEvent ReceiveProgress(Me, New WinsockReceiveProgressEventArgs(UrlToGo, count, ContentLength))
End If
End Sub
Delegate Sub dDownloadCancelledInvoke()
Sub DownloadCancelledInvoke()
If Me.InvokeRequired Then
Dim d As New dDownloadCancelledInvoke(AddressOf DownloadCancelledInvoke)
Me.Invoke(d, New Object() {})
Else
' Вызов события Идет прием данных
RaiseEvent DownloadCancelled(Me, New EventArgs)
End If
End Sub

' ВЫПОЛНИТЬ ПРОСТО ЗАПРОС
Public Sub ExecuteQuery(Optional ByVal withClose As Boolean = True)

If UrlToGo = "" Then Exit Sub

' Вызов события ОтправляетсяЗапроса
If withClose Then
Dim e As New System.ComponentModel.CancelEventArgs()
RaiseEvent SendingQuery(Me, e)
If e.Cancel Then Exit Sub
End If

' Подготовка хттп-класса к запросу
PeredQuery()

' запрос!
Try
System.Windows.Forms.Application.DoEvents()
myHttpWebResponse = myHttpWebRequest.GetResponse()
Catch ex As Exception
Me.ResultCode = ex.Message
If IgnorEr = False Then Throw ex
Exit Sub
End Try

' Вызов события ОтправилсяЗапрос
RaiseEvent SentQuery(Me, New EventArgs())

' Занесение результатов запроса в хттп-класс
PosleQuery()

If withClose Then
' Получить собственно код страницы
Dim myStreamReader As New IO.StreamReader(myHttpWebResponse.GetResponseStream, System.Text.Encoding.GetEncoding(EncodingPage))
ResultQuery = myStreamReader.ReadToEnd()
myStreamReader.Close()

' Вызов события ПолученОтвет
RaiseEvent ReceivedResponse(Me, New EventArgs)

myHttpWebResponse.Close()
DelayQuery()
End If

End Sub

' Подготовка хттп-класса к запросу
Sub PeredQuery()
' Задаем заголовки, в зависимости от настроек
myHttpWebRequest = Net.HttpWebRequest.Create(UrlToGo)
If ProxyIp <> "" Then myHttpWebRequest.Proxy = New Net.WebProxy(ProxyIp, Convert.ToInt32(ProxyPort))
myHttpWebRequest.Referer = UrlReferer
myHttpWebRequest.UserAgent = UserAgent
myHttpWebRequest.Accept = Accept
myHttpWebRequest.Method = HttpMethod
myHttpWebRequest.Timeout = TimeOut
myHttpWebRequest.Headers.Add("Accept-Language", LanguagePage)
myHttpWebRequest.KeepAlive = KeepAlive
myHttpWebRequest.AllowAutoRedirect = AllowAutoRedirect
myHttpWebRequest.ContentType = ContentType
'myHttpWebRequest.Headers.Add(HttpRequestHeader.Cookie, Cookies)
' Dim cc As CookieCollection = GetCookiesFromoMy(Cookies)
myHttpWebRequest.CookieContainer = New Net.CookieContainer()
'If cc IsNot Nothing Then
myHttpWebRequest.CookieContainer.Add(GetCookiesFromoMy(CookiesQueries))
'Dim cooo As New CookieCollection
'myHttpWebRequest.CookieContainer = New CookieContainer()
'If cooo IsNot Nothing Then
' myHttpWebRequest.CookieContainer.Add(cooo)
'End If

' передаем переменные
If ContentQuery.Length > 0 Then
Dim ByteArr As Byte() = System.Text.Encoding.GetEncoding(EncodingPage).GetBytes(ContentQuery)
myHttpWebRequest.ContentLength = ByteArr.Length()
Dim sw As New IO.BinaryWriter(myHttpWebRequest.GetRequestStream(), System.Text.Encoding.GetEncoding(EncodingPage))
sw.Write(ByteArr, 0, ByteArr.Length)
sw.Close()
End If
End Sub
' Занесение результатов запроса в хттп-класс
Sub PosleQuery()
'получаем куки, которые возвратил UrlToGo
''Cookies = ""
'If Not String.IsNullOrEmpty(myHttpWebResponse.Headers("Set-Cookie")) Then
' Cookies = myHttpWebResponse.Headers("Set-Cookie")
'End If

Dim cooo As Net.CookieCollection = GetCookiesFromoMy(CookiesQueries)
'myHttpWebResponse.Cookies = myHttpWebRequest.CookieContainer.GetCookies(myHttpWebRequest.RequestUri)
'If myHttpWebResponse.Cookies IsNot Nothing Then
' ' cooo.Add(myHttpWebResponse.Cookies)
' Также надо добавить куки из заголовка, если такие есть.
If Not String.IsNullOrEmpty(myHttpWebResponse.Headers("Set-Cookie")) Then
' Разбираем куки
Dim i, j As Integer
Dim ch() As String = myHttpWebResponse.Headers("Set-Cookie").Replace(", ", "~!@#$%v").Split(",")
Dim cc As New Net.CookieContainer()
For i = 0 To ch.Length - 1
Dim cParams() As String = ch(i).Replace("~!@#$%v", ", ").Split(New String() {"; "}, StringSplitOptions.None)
Dim co As New Net.Cookie(cParams(0).Split("=")(0), cParams(0).Substring(cParams(0).IndexOf("=") + 1))
' задаем основные параметры из заголовка
For j = 1 To cParams.Length - 1
If cParams(j).IndexOf("expires=") = 0 Then
co.Expires = cParams(j).Substring(cParams(j).IndexOf("=") + 1)
ElseIf cParams(j).IndexOf("path=") = 0 Then
co.Path = cParams(j).Substring(cParams(j).IndexOf("=") + 1)
ElseIf cParams(j).IndexOf("domain=") = 0 Then
co.Domain = cParams(j).Substring(cParams(j).IndexOf("=") + 1)
ElseIf UCase(cParams(j)).IndexOf(UCase("httponly")) = 0 Then
co.HttpOnly = True
End If
Next
' если в заголовке небыли явно указаны параметры, то указываим их сами
If co.Path = "" Then co.Path = myHttpWebRequest.RequestUri.AbsolutePath
If co.Domain = "" Then co.Domain = myHttpWebRequest.RequestUri.Host
' добавить кук
cooo.Add(co)
Next
'End If
End If
CookiesQueries = GetCookiesToMy(cooo)

' Основные данные запроса
ResultCode = myHttpWebResponse.StatusCode
ContentType = myHttpWebResponse.ContentType
If ContentType.IndexOf("charset=") <> -1 Then
EncodingPage = ContentType.Substring(ContentType.IndexOf("charset=") + "charset=".Length)
End If
ContentQuery = ""
ContentLength = myHttpWebResponse.ContentLength
Headers = GetHeadersToMy(myHttpWebResponse.Headers)

' урл редиректа приводим в божеский вид
UrlRedirect = myHttpWebResponse.Headers("Location")
' Стандартизировать ссылку. Например, если ссылка вернута относительно, а не абсолютно
UrlRedirect = ConnectUris(myHttpWebResponse.ResponseUri.AbsoluteUri, UrlRedirect)
End Sub
#End Region


#Region "UserInterface"
Public IsDevelop As Boolean = False

Private Sub Internet_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Tmr.Interval = 1

Label1.Text = trans(Label1.Text.Split(":")(0)) & ":"
Label2.Text = trans(Label2.Text.Split(":")(0)) & ":"
Label3.Text = trans(Label3.Text.Split(":")(0)) & ":"
Label4.Text = trans(Label4.Text.Split(":")(0)) & ":"
Label5.Text = trans(Label5.Text.Split(":")(0)) & ":"
Button1.Text = trans(Button1.Text)
TextBox1.Text = UrlToGo
TextBox4.Text = UrlRedirect

Dim arr(ContentTypes.Values.Count - 1) As String, i As Integer
ContentTypes.Keys.CopyTo(arr, 0)
For i = 0 To arr.Length - 1
arr(i) = arr(i).Replace("""", "")
Next
ComboBox1.Items.AddRange(arr)
ComboBox1.Text = ContentType

Dim arr2(HttpMethods.Values.Count - 1) As String
HttpMethods.Keys.CopyTo(arr2, 0)
ComboBox2.Items.AddRange(arr2)
ComboBox2.Text = HttpMethod
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If IsDevelop = False Then
UrlToGo = TextBox1.Text
ContentQuery = TextBox2.Text
ContentType = ComboBox1.Text
HttpMethod = ComboBox2.SelectedItem
ExecuteQuery()
End If
End Sub

Private Sub ComboBox1_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox1.TextChanged
ConTyp = sender.text
End Sub
Private Sub ComboBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox2.TextChanged
Mtd = sender.text
End Sub
Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
UrTG = sender.text
End Sub
Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged
Prms = sender.text
End Sub
Private Sub TextBox3_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged
src = sender.text
End Sub
Private Sub TextBox4_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox4.TextChanged
UrlRdr = sender.text
End Sub
#End Region

End Class

Iska
14-10-2013, 19:30
by_gangster, всё верно. Кушает память, поскольку тупо держит всё загружаемое в «System.Collections.Generic.List»Можно ли как-нибудь сделать так что бы файл не помещался в память а сразу же скачивался и был рядом с программой ? »
Часть первая: нельзя, поскольку работа ведётся только в памяти. Часть вторая: зато возможно уменьшить требования к потреблению, если использовать асинхронную (в терминах приведённого кода) загрузку и буфер, который будет «сбрасываться» в файл по мере заполнения.

ничего особенного в этой программе нет она просто скачивает файл и ложит его там же где и сама программа. »
Вам не проще будет пользовать банальный «wget.exe»?

by_gangster
02-11-2013, 01:04
Iska, Извините за наглость не могли бы вы мне сделать так что бы уменьшить требования к потреблению, если использовать асинхронную (в терминах приведённого кода) загрузку и буфер, который будет «сбрасываться» в файл по мере заполнения. » ?

mrcnn
02-11-2013, 02:26
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
Побайтовое чтение входного потока. У вас он добавляется в «System.Collections.Generic.List» как уже написал Iska, а можно сразу писать в файл, не добавляя в
Dim all As New System.Collections.Generic.List(Of Byte)


Запись в файл осуществляется следующим методом
IO.File.WriteAllBytes(FlName, lst.ToArray)

Iska
02-11-2013, 05:56
ska, Извините за наглость не могли бы вы мне сделать так что бы »
by_gangster, не мог бы ;). К сожалению, есть разница между «уметь разобраться» и «уметь сделать». Моих знаний для второго явно недостаточно. Ситуация та же, что и с С++: понять, как «оно работает», я могу. Исправить по потребности — вряд ли.

Повторю вопрос:
ничего особенного в этой программе нет она просто скачивает файл и ложит его там же где и сама программа. »
Вам не проще будет пользовать банальный «wget.exe»? »

by_gangster
02-11-2013, 13:06
mrcnn, т.е мне нужно сделать так ?


Dim bts() As Byte = IO.File.WriteAllBytes(FlName, lst.ToArray)


Ошибку показывает и говорит что "lst" не объявлен.

mrcnn
02-11-2013, 15:17
mrcnn, т.е мне нужно сделать так ?
Код:
Dim bts() As Byte = IO.File.WriteAllBytes(FlName, lst.ToArray)
Ошибку показывает и говорит что "lst" не объявлен. »

Нет. Вы объявили переменную, но в ней находится мусор. Чтобы в переменной мусора не было, сперва считывается из входного потока набор данных, следующим образом

Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)

Теперь вы можете записать это в файл
IO.File.WriteAllBytes(FlName, bts)


Получится или нет - не знаю. Попробуйте написать и испытать.

by_gangster
02-11-2013, 18:22
mrcnn,
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
IO.File.WriteAllBytes(FlName, bts)


Так ? Если да то после начала скачивания файл то ложится рядом с прогой но через 1 сек. ошибка и файл весит 10кб.

И у меня Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
2 раза упоминается в коде.

' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do
all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)
Loop
DownloadSuccess(all)
End If
End Sub
' Функция реализующая поток, который скачивайт файл порциями BufferSize
Sub AsyncDownload(ByVal stream As Object)
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(stream)
Dim all As New System.Collections.Generic.List(Of Byte)
Do
' Всякие Прерывания и Паузы потока
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
While DownloadPause
System.Windows.Forms.Application.DoEvents()
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
End While

' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)

If bts.Length = 0 Then Exit Do
all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)
Loop
DownloadSuccess(all)
End Sub

mrcnn
03-11-2013, 05:07
IO.File.WriteAllBytes(FlName, bts)
попробуйте добавить два раза перед
all.AddRange(bts)

И закомментируйте вызов функции DownloadSuccess(all)

by_gangster
03-11-2013, 13:06
mrcnn,

Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do
IO.File.WriteAllBytes(FlName, bts)
all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)
Loop
'DownloadSuccess(all)'
End Sub
Так сделал в двух местах. Всё равно ошибка...

mrcnn
03-11-2013, 19:31
В функции AsyncDownload не открыт файл. Открывается он следующим образом в начале функции

' Получить собственно файл
If PathForDownl = "" Then
FlName = IO.Path.GetTempPath & IO.Path.GetFileName(fl)
Else
PathForDownloads = GetMaxPath(PathForDownloads)
If IO.Directory.Exists(PathForDownloads) = False Then
IO.Directory.CreateDirectory(PathForDownloads)
End If
FlName = PathForDownloads & "\" & IO.Path.GetFileName(fl)
End If
If IO.Path.GetFileName(FlName).Split(IO.Path.GetInvalidFileNameChars).Length > 1 Then
FlName = IO.Path.GetTempPath & GetUIN() & ".tmp"
End If

by_gangster
03-11-2013, 23:30
mrcnn, Немного не понял...в коде же ничего не изменено...

mrcnn
04-11-2013, 06:20
Попробуйте оставить в неизменности функцию AsyncDownload, так как в ней не определено название файла, что является ошибкой. Если пишете об ошибке, то приведите ее текст. И программа не VBA а VB.NET

by_gangster
04-11-2013, 13:55
mrcnn, Извините пожалуйста, но я уже дуб-дубом.. Можете сказать толком что в этом участке менять ?

' Получить собственно файл
If PathForDownl = "" Then
FlName = IO.Path.GetTempPath & IO.Path.GetFileName(fl)
Else
PathForDownloads = GetMaxPath(PathForDownloads)
If IO.Directory.Exists(PathForDownloads) = False Then
IO.Directory.CreateDirectory(PathForDownloads)
End If
FlName = PathForDownloads & "\" & IO.Path.GetFileName(fl)
End If
If IO.Path.GetFileName(FlName).Split(IO.Path.GetInvalidFileNameChars).Length > 1 Then
FlName = IO.Path.GetTempPath & GetUIN() & ".tmp"
End If

' Получить асинхронно
If WaitForDownload = False Then
thr = New Threading.Thread(AddressOf AsyncDownload)
thr.Start(myHttpWebResponse.GetResponseStream)

' Получить синхронно
Else
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(myHttpWebResponse.GetResponseStream)
Dim all As New System.Collections.Generic.List(Of Byte)
Do
' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do
all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)

Loop
DownloadSuccess(all)
End If
End Sub
' Функция реализующая поток, который скачивайт файл порциями BufferSize
Sub AsyncDownload(ByVal stream As Object)
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(stream)
Dim all As New System.Collections.Generic.List(Of Byte)
Do
' Всякие Прерывания и Паузы потока
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
While DownloadPause
System.Windows.Forms.Application.DoEvents()
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
End While
' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do

all.AddRange(bts)

' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)

Loop
DownloadSuccess(all)
End Sub

mrcnn
04-11-2013, 15:20
' Получить собственно файл
If PathForDownl = "" Then
FlName = IO.Path.GetTempPath & IO.Path.GetFileName(fl)
Else
PathForDownloads = GetMaxPath(PathForDownloads)
If IO.Directory.Exists(PathForDownloads) = False Then
IO.Directory.CreateDirectory(PathForDownloads)
End If
FlName = PathForDownloads & "\" & IO.Path.GetFileName(fl)
End If
If IO.Path.GetFileName(FlName).Split(IO.Path.GetInvalidFileNameChars).Length > 1 Then
FlName = IO.Path.GetTempPath & GetUIN() & ".tmp"
End If

'Открыть файл

' Поток в файл (объявление)
Dim fstr As New System.IO.FileStream(FlName, System.IO.FileMode.OpenOrCreate)



'Открытие потока в файл
'fstr = System.IO.File.OpenWrite(FlName)



' Получить асинхронно
If WaitForDownload = False Then

fstr.Close()


thr = New Threading.Thread(AddressOf AsyncDownload)
thr.Start(myHttpWebResponse.GetResponseStream)

' Получить синхронно
Else
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(myHttpWebResponse.GetResponseStream)
Dim all As New System.Collections.Generic.List(Of Byte)
Do
' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do


fstr.Seek(0, System.IO.SeekOrigin.End)


For Each bytevalue As Byte In bts
fstr.WriteByte(bytevalue)
fstr.Seek(0, System.IO.SeekOrigin.End)
Next



'all.AddRange(bts)
' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)

Loop




'DownloadSuccess(all)
End If

' Функция реализующая поток, который скачивайт файл порциями BufferSize
Sub AsyncDownload(ByVal stream As Object)
FileDownloading = True
Dim myStreamReader As New IO.BinaryReader(stream)
Dim all As New System.Collections.Generic.List(Of Byte)

Dim fstr As New System.IO.FileStream(FlName, System.IO.FileMode.OpenOrCreate)


Do
' Всякие Прерывания и Паузы потока
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
While DownloadPause
System.Windows.Forms.Application.DoEvents()
If FileDownloading = False Then DownloadCancelledInvoke() : myStreamReader.Close() : Exit Sub
End While
' Собственно получения порции данных
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
If bts.Length = 0 Then Exit Do

fstr.Seek(0, System.IO.SeekOrigin.End)

For Each bytevalue As Byte In bts
fstr.WriteByte(bytevalue)
fstr.Seek(0, System.IO.SeekOrigin.End)
Next

'all.AddRange(bts)

' Вызов события Идет прием данных
ReceiveProgressInvoke(all.Count)

Loop
DownloadSuccess(all)
End Sub

by_gangster
04-11-2013, 17:49
mrcnn, работает спасибо, но у меня в программе раньше работал прогресс бар и показывалось в процентах сколько скачался файл, а теперь не работает...

Ой, извините, не заметил закомментированные строки. Раскоментил, всё работает спасибо.


Но когда работает прогресс бар и показывается процент скачивания, то память начинает жрать по жёсткому...Почему так происходит ?

mrcnn
05-11-2013, 01:52
Потому что делает по-старому.
Память занимает строка all.AddRange(bts).
Функция DownloadSuccess(all) делает по-старому запись файла из буфера в памяти (добавление в этот буфер all.AddRange(bts) ) , поэтому ее нужно закомментировать.
Прогресс показывает функция ReceiveProgressInvoke(all.Count) по событию ReceiveProgress, а она не закомментирована.

by_gangster
05-11-2013, 20:23
mrcnn, Если закомментирована строка all.AddRange(bts) то прогресс-бар не работает.




© OSzone.net 2001-2012