⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cdownload.vb

📁 HTTP下载编程
💻 VB
字号:
Imports System
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.WinForms
Imports System.Data
Imports System.Net
Imports System.Threading
Imports System.IO
Imports System.Text
'Added om 11th Jan 2000 for File Access Permission
Imports System.Security.Permissions
Public Class CDownload
    Private ReadOnly UriToResolve As String
    Private ReadOnly proxy As Boolean
    Private ReadOnly normalUserName As String
    Private ReadOnly normalPassword As String
    Private ReadOnly proxyServer As String
    Private ReadOnly proxyUserName As String
    Private ReadOnly proxyPassword As String
    Private ReadOnly proxyPort As Integer
    Private ReadOnly Downloadedfile As String
    Private ReadOnly frmMain As frmFileDownload = Nothing
    Private pfileWriter As StreamWriter = Nothing
    Private sFile As String = Nothing
    Public Overloads Sub New(ByVal url As String, ByVal normalUser As String, ByVal normalPass As String, ByVal proxy As Boolean, ByVal proxyServer As String, ByVal proxyPort As Integer, ByVal proxyUser As String, ByVal proxyPass As String, ByVal fileNameOnDisk As String, ByVal frmMain As frmFileDownload)
        MyBase.New()
        Me.UriToResolve = url
        Me.normalUserName = normalUser
        Me.normalPassword = normalPass
        Me.proxy = proxy
        Me.proxyServer = proxyServer
        Me.proxyUserName = proxyUser
        Me.proxyPassword = proxyPass
        Me.proxyPort = proxyPort
        Me.Downloadedfile = fileNameOnDisk
        Me.frmMain = frmMain
    End Sub
    Public Overloads Sub New(ByVal url As String, ByVal frmMain As frmFileDownload)
        Me.New(url, Nothing, Nothing, False, Nothing, 0, Nothing, Nothing, "C:\temp\", frmMain)
        
    End Sub
    Public Overloads Sub New(ByVal fileURL As String, ByVal fileNameOnDisk As String, ByVal frmMain As frmFileDownload)
        Me.New(fileURL, Nothing, Nothing, False, Nothing, 0, Nothing, Nothing, fileNameOnDisk, frmMain)
    End Sub
    Public Sub downloadFile()
        Dim length As Integer = 1024
        Dim Buffer(1025) As Char
        Dim bytesread As Integer = 0
        Dim ResolvedURI As Boolean = False
        While (Not ResolvedURI)
            Try
                If (proxy) Then
                    Dim proxyObject As DefaultControlObject = New DefaultControlObject(proxyServer, proxyPort)
                    ' Disable Proxy use when the host is local i.e. without periods.
                    proxyObject.ProxyNoLocal = True
                    ' Now actually take over the global with our new settings, all new requests 
                    ' use Me proxy info
                    GlobalProxySelection.Select = proxyObject
                End If
                
                'Create the request object
                Dim request As HttpWebRequest = CType(WebRequestFactory.Create(UriToResolve), HttpWebRequest)
                request.AllowAutoRedirect = True
                If (normalUserName <> Nothing) Then
                    request.Credentials = New SingleCredential(normalUserName, normalPassword)
                End If
                If (proxyUserName <> Nothing) Then
                    request.Credentials = New SingleCredential(proxyUserName, proxyPassword)
                End If
                'Create the response object
                Dim response As HttpWebResponse = CType(request.GetResponse(), HttpWebResponse)
                
                ' Get the document name from the respone by casting it to System.URI
                'URI uri=(URI) response;
                ' There seems to a property which is called as CurrentDocument 
                ' but i am not able to get it?
                ' so try Me way to get the file name.
                Dim absolutePath, fileName As String
                absolutePath = response.ResponseURI.AbsolutePath
                'parse it from end to get the actual file name
                Dim i As Integer = instrrev(absolutePath, "/")
                If (i > 0 And len(absolutepath) > 1) Then
                    fileName = absolutePath.Substring(i)
                Else
                    'Person request default page from
                    'server so no way to resolve file name
                    fileName = "default.htm"
                End If
                Console.WriteLine("file Name is {0}", fileName)
                Console.WriteLine(response.Status)
                'Successfully resolved the URI
                ResolvedURI = True
                'Check for Headers
                'Console.WriteLine("Response Header {0} ", response.Headers)
                'Console.WriteLine("Response ContentType {0} ", response.ContentType)
                'Console.WriteLine("Response ContentLength {0} ", response.ContentLength)
                
                Dim fileSizeInBytes As Long = response.ContentLength
                Dim myDirectory As String
                frmMain.HandleStatus(CInt(fileSizeInBytes), False)
                
                If (Downloadedfile.Length >= 3) Then
                    Dim j As Integer = Downloadedfile.LastIndexOf("\")
                    If (j = Downloadedfile.Length) Then
                        myDirectory = Downloadedfile
                        sFile = Downloadedfile & fileName
                    Else
                        If mydirectory = "" Then mydirectory = Downloadedfile
                        If right(mydirectory, 1) <> "\" Then myDirectory = Downloadedfile & "\"
                        sFile = myDirectory & fileName
                    End If
                End If
                ' Create a file on the disk to save the file
                ' No check for file here , but it should be there
                Try
                    If (File.FileExists(sFile)) Then
                        Select Case (MessageBox.Show("File Already Exist..Delete it..", "File Exists", MessageBox.OKCancel))
                            Case DialogResult.OK
                                File.Delete(sFile)
                            Case Else
                                Throw New ApplicationException("File exists change the file name before downloading")
                        End Select
                    End If
                    'FileIOPermission 
                    'FileIOPermissionAccess specifies the actions that can be performed on the file or folder. 
                    'In addition, the actions can be combined using a bitwise OR to form more complicated access requests.
                    'Access to a folder implies access to all of the files it contains, 
                    'as well as access to all of the files and folders in its subfolders. 
                    'For example, Read access to C:\folder1\ implies Read access to C:\folder1\file1.txt, 
                    'C:\folder1\folder2\, C:\folder1\folder2\file2.txt, and so on.
                    ' Now give a FileIOPermission to the Directory
                    Try
                        Dim f As FileIOPermission = New FileIOPermission(FileIOPermissionAccess.AllAccess, myDirectory)
                        pfileWriter = New StreamWriter(New FileStream(sFile, FileMode.CreateNew, FileAccess.Write, FileShare.None))
                    Catch eArgNull As ArgumentNullException
                        'throw back to indicate user that error has occured
                        ResolvedURI = True
                        frmMain.EnableDownloadAgainAfterError(eArgNull)
                    Catch eArg As ArgumentException
                        'throw back to indicate user that error has occured
                        ResolvedURI = True
                        frmMain.EnableDownloadAgainAfterError(eArg)
                    Catch eOther As Exception
                        'throw back to indicate user that error has occured
                        ResolvedURI = True
                        frmMain.EnableDownloadAgainAfterError(eOther)
                    End Try
                Catch eIO As IOException
                    'throw back to indicate user that error has occured
                    ResolvedURI = True
                    frmMain.EnableDownloadAgainAfterError(eIO)
                End Try
                
                'Get a readable stream from the server 
                Dim sr As StreamReader = New StreamReader(response.GetResponseStream(), Encoding.ASCII)
                'Read from the stream and write any data to the console
                bytesread = sr.Read(Buffer, 0, length)
                pfileWriter.Write(Buffer, 0, bytesread)
                fileSizeInBytes -= bytesread
                frmMain.HandleStatus(CInt(fileSizeInBytes), True)
                While (bytesread > 0)
                    'Console.Write( Buffer,0, bytesread);
                    pfileWriter.Write(Buffer, 0, bytesread)
                    fileSizeInBytes -= bytesread
                    frmMain.HandleStatus(CInt(fileSizeInBytes), True)
                    bytesread = sr.Read(Buffer, 0, length)
                End While
                frmMain.HandleStatus(0, True)
            Catch WebExcp As WebException
                'If you get to Me point, the exception has been caught
                Console.WriteLine("A WebException has been caught!")
                'Write out the Exception message
                Console.WriteLine(WebExcp.ToString())
                'Get the WebException status code
                Dim st As Integer = Convert.ToInt32(WebExcp.Status)
                If (st = 7) Then ' 7 indicates a protocol error, thus a WebResonse object should exist
                    'Write out the WebResponse protocol status
                    Console.Write("The protocol error returned by the server is ")
                    Console.WriteLine(WebExcp.Response.Status)
                    Console.WriteLine()
                End If
                'throw back to indicate user that error has occured
                ResolvedURI = True
                frmMain.EnableDownloadAgainAfterError(WebExcp)
            Catch UriExcp As URIFormatException
                ' If you get to Me point, the exception has been caught
                Console.WriteLine("A URIFormatException has been caught!")
                ' Write out the Exception message
                Console.WriteLine(UriExcp.ToString())
                'throw back to indicate user that error has occured
                ResolvedURI = True
                frmMain.EnableDownloadAgainAfterError(UriExcp)
            Catch eOthers As Exception
                'throw back to indicate user that error has occured
                ResolvedURI = True
                frmMain.EnableDownloadAgainAfterError(eOthers)
            Finally
                If pfileWriter <> Nothing Then
                    'Close the opened file
                    pfileWriter.Close()
                End If
            End Try
        End While
        
    End Sub
    
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -