Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - [решено] Помогите исправить.

Ответить
Настройки темы
VBA - [решено] Помогите исправить.

Пользователь


Сообщения: 144
Благодарности: 3

Профиль | Отправить PM | Цитировать


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

Отправлено: 14:56, 13-10-2013

 

Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


by_gangster, разговор ни о чём. Приведите код.
Это сообщение посчитали полезным следующие участники:

Отправлено: 15:12, 13-10-2013 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Пользователь


Сообщения: 144
Благодарности: 3

Профиль | Отправить PM | Цитировать


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

Отправлено: 15:56, 13-10-2013 | #3


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


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

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

Отправлено: 19:30, 14-10-2013 | #4


Пользователь


Сообщения: 144
Благодарности: 3

Профиль | Отправить PM | Цитировать


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

Отправлено: 01:04, 02-11-2013 | #5


Ветеран


Сообщения: 1404
Благодарности: 135

Профиль | Отправить PM | Цитировать


Код: Выделить весь код
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)

-------
Ehhh.. what's up, doc?..

Это сообщение посчитали полезным следующие участники:

Отправлено: 02:26, 02-11-2013 | #6


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


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

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

Отправлено: 05:56, 02-11-2013 | #7


Пользователь


Сообщения: 144
Благодарности: 3

Профиль | Отправить PM | Цитировать


mrcnn, т.е мне нужно сделать так ?

Код: Выделить весь код
Dim bts() As Byte = IO.File.WriteAllBytes(FlName, lst.ToArray)
Ошибку показывает и говорит что "lst" не объявлен.

Отправлено: 13:06, 02-11-2013 | #8


Ветеран


Сообщения: 1404
Благодарности: 135

Профиль | Отправить PM | Цитировать


Цитата by_gangster:
mrcnn, т.е мне нужно сделать так ?
Код:
Dim bts() As Byte = IO.File.WriteAllBytes(FlName, lst.ToArray)
Ошибку показывает и говорит что "lst" не объявлен. »
Нет. Вы объявили переменную, но в ней находится мусор. Чтобы в переменной мусора не было, сперва считывается из входного потока набор данных, следующим образом

Код: Выделить весь код
Dim bts() As Byte = myStreamReader.ReadBytes(BufferSize)
Теперь вы можете записать это в файл
Код: Выделить весь код
IO.File.WriteAllBytes(FlName, bts)
Получится или нет - не знаю. Попробуйте написать и испытать.

-------
Ehhh.. what's up, doc?..

Это сообщение посчитали полезным следующие участники:

Отправлено: 15:17, 02-11-2013 | #9


Пользователь


Сообщения: 144
Благодарности: 3

Профиль | Отправить PM | Цитировать


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

Отправлено: 18:22, 02-11-2013 | #10



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - [решено] Помогите исправить.

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
Ошибка - помогите исправить данную ошибку simsa Microsoft Windows 2000/XP 2 26-11-2012 15:50
C/C++ - Помогите исправить ошибки!!!!! Nastasya Программирование и базы данных 2 23-05-2011 22:09
Помогите исправить ошибку! Guest Хочу все знать 1 15-05-2004 16:55
Помогите исправить ошибку! Guest Сетевые технологии 1 12-05-2004 10:11




 
Переход