Results 1 to 2 of 2

Thread: Need help with usercontrol that uses MSXML2.ServerXMLHTTP

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2011
    Posts
    498

    Question Need help with usercontrol that uses MSXML2.ServerXMLHTTP

    I have created a usercontrol similar to the VB Asycdownload usercontrol and it works, but i thought i had the cancel
    downloads working but i dont. I cannot figure out if i start 6 downloads, i would like to cancel all downloads.
    Sometimes the VBAscyncdownload does not work with some pages or downloads so tried to make something that works the same.

    Please not that sometimes i create and array of the usercontrol so would need usercontrol(x).Canceldownload

    can someone a bit smarter help me please. tks

    code below is placed on a usercontrol.

    Code:
    
    'status code for getting the page successfully.
    Private Const HttpStatusOK200 As Integer = 200
    
    'status code for not getting the page
    Private Const HttpFileNotFound404 As Integer = 404
    
    'status code for request timed out.
    Private Const HttpTimeOutError12002 As Integer = 12002
    
    Private WithEvents http As WinHttpRequest
    
    Private FF As Integer
    Private mContentLength As Long
    Private mProgress As Long
    Dim strLocalFile As String
    Dim Cancel_Download As Boolean
    Public Event Progress(percent As Single)
    Public Event Zero()
    Public Event Finished(LocalFile As String)
    Public Event PageDownloadComplete(Data As String)
    Public CurrentDownloads As New Collection
    
    
    Public Sub CancelDownload()
    
        http.Abort
        Close #FF
        Kill strLocalFile
        RaiseEvent Progress(0)
        CurrentDownloads.Remove 1
        RefreshStatus
    End Sub
    
    Public Sub GetWebData(ByVal URL As String)
    
        On Error GoTo err
        Dim objHTTP As Object
    
        Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
        objHTTP.Open "GET", URL, True
        objHTTP.SetRequestHeader "Authorization", "Bearer " & "" ' AuthCode
        objHTTP.SetRequestHeader "Accept-Language", "en"
        objHTTP.sEnd
        
         Do While objHTTP.ReadyState <> 4
    
            If objHTTP.ReadyState = HttpTimeOutError12002 Then
    
            ElseIf objHTTP.ReadyState = HttpFileNotFound404 Then
    
            End If
            DoEvents
    
        Loop
        
        
        RaiseEvent PageDownloadComplete(objHTTP.ResponseText)
    
        Set objHTTP = Nothing
    
        Exit Sub
    
    err:
    
        
    End Sub
    
    Public Sub DownloadBinary(ByVal BinaryURL As String, ByVal LocalFile As String)
        strLocalFile = LocalFile
        ' Create the WinHTTPRequest ActiveX Object.
        Set http = New WinHttpRequest
        ' Open an HTTP connection.
        http.Open "GET", BinaryURL, True  'True means asynch.
        ' Send the HTTP Request.
        http.sEnd
        CurrentDownloads.Add BinaryURL, BinaryURL
        RefreshStatus
    End Sub
    
    Private Sub http_OnResponseDataAvailable(Data() As Byte)
        mProgress = mProgress + UBound(Data) + 1
        RaiseEvent Progress(Format((mProgress / mContentLength) * 100, "00"))
        Put #FF, , Data
    End Sub
    
    Private Sub http_OnResponseFinished()
        Close #FF
        RaiseEvent Finished(strLocalFile)
        On Error Resume Next
        CurrentDownloads.Remove 1
        RefreshStatus
        On Error GoTo 0
    
    End Sub
    
    Private Sub http_OnResponseStart(ByVal Status As Long, ByVal ContentType As String)
    'Text1.Text = http.getAllResponseHeaders()
        mProgress = 0
        mContentLength = CLng(http.GetResponseHeader("Content-Length"))
        FF = FreeFile
        'ProgressBar1.Max = mContentLength
        Open strLocalFile For Binary As #FF
    
    End Sub
    
    Private Sub UserControl_Resize()
        UserControl.Width = 960
        UserControl.Height = 960
    End Sub
    
    Private Sub RefreshStatus()
        UserControl.Cls
        UserControl.CurrentX = 0
        UserControl.CurrentY = 0
        UserControl.Print CurrentDownloads.Count
    
        If CurrentDownloads.Count = 0 Then
            RaiseEvent Zero
        End If
    
    End Sub

  2. #2
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Need help with usercontrol that uses MSXML2.ServerXMLHTTP

    you can use winhttp,or winnet.dll,use Download continuously like reading a file, but it can also be interrupted.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width