downloadtask.vb

编程环境VB.NET2005 多线程下载

Imports System.Text
Imports System.Data.OleDb

Public Class MyDownloadTask
#Region "dim"
    Private m_TaskInfo As New MyDownTaskClass
    Private m_canExit As Boolean
    Private isWorking As Boolean = False
    Private isEnd As Boolean = False
    Private WithEvents UpTimer As New Timer
    Friend thColl As New Collection
    Friend Event errorInfo()
    Friend showDetail As Boolean = False
    Private linkItem As ListViewItem
    Private closeTH As Integer
    Private maxSpeed As Integer = 5 * 100
    Private isStop As Boolean
    Private initiativeExit As Boolean
    Friend Event ShowDownTaskInfo(ByVal sender As MyDownloadTask, ByVal tagLvi As ListViewItem, ByVal info As String)
#End Region
    'Delegate Sub AddWebBrowserCallBack()
    ' Public Delegate Sub ShowInfo(ByVal sender As Object, ByVal e As String) '取最新更新期数
    'Sub TrueShow(ByVal sender As Object, ByVal e As String)
    '    MsgBox(e.ToString)
    'End Sub
    Public Property MyCanExit() As Boolean
        Get
            Return m_canExit
        End Get
        Set(ByVal value As Boolean)
            m_canExit = value
        End Set
    End Property
    Public Property MyTaskInfo() As MyDownTaskClass
        Get
            Return Me.m_TaskInfo
        End Get
        Set(ByVal value As MyDownTaskClass)
            Me.m_TaskInfo = value
        End Set
    End Property
    Sub StartTask(ByVal senderLvi As ListViewItem)
        Me.initiativeExit = False
        Me.MyCanExit = False
        Me.downError = False
        'If Me.isWorking = True Then Exit Sub
        Me.linkItem = senderLvi '取项目索引
        If Me.MyTaskInfo.thData Is Nothing Then
            Me.IniTaskInfo(Me.MyTaskInfo.downUrl, Me.MyTaskInfo.savePathfilename, Me.MyTaskInfo.downThreadAmount)
            Me.linkItem.SubItems(3).Text = Me.MyTaskInfo.Complete
            Me.linkItem.SubItems(2).Text = Me.MyTaskInfo.Length
        Else
            Me.LoadTaskInfo()
            Me.linkItem.SubItems(3).Text = Me.MyTaskInfo.Complete
            Me.linkItem.SubItems(2).Text = Me.MyTaskInfo.Length
        End If
        Me.linkItem.SubItems(0).Text = "1" '正在下载
        Dim thStr As String = BinToStr(Me.MyTaskInfo.thData)
        Me.thColl.Clear() '先清空线程集合后再说
        BindThreadToDownTask(Me, thStr, Me.MyTaskInfo.savePathfilename, Me.MyTaskInfo.downUrl)
        Me.closeTH = Me.thColl.Count
        Me.UpTimer.Interval = 1000
        Me.UpTimer.Enabled = True
        Me.isStop = False

        For Each t As MyDownThread In Me.thColl
            't.startdown()
            'System.Threading.Thread.Sleep(1000)
            Dim th As New System.Threading.Thread(AddressOf t.startdown)
            th.Start()
        Next
        Me.isWorking = True
        Me.isEnd = False
    End Sub

    Sub StopTask(ByVal senderLvi As ListViewItem, ByVal itemIndex As Integer)
        'Me.isWorking = True 'temp disable start
        Me.isStop = True
        Me.UpTimer.Enabled = False
        Me.initiativeExit = True
        For Each t As MyDownThread In Me.thColl
            t.stopDown()
        Next
        senderLvi.SubItems(0).Text = "9" '正在下载
    End Sub
    Dim errcount As Integer
    Dim downError As Boolean
    Sub thStop(ByVal sender As MyDownThread, ByVal saveData As MyThreadStru)
        'Me.DownDone()
        'Exit Sub
        ' Me.BeginInvoke(New ShowInfo(AddressOf TrueShow), New Object() {sender, "456"})
        'Exit Sub
        'Dim dt As MyDownThread = CType(sender, MyDownThread)
        Static errThColl As New Collection
        'errcount += 1 '有错误的线程
        If Me.initiativeExit = False Then '不是主动退出的情况下
            ' Try
            Select Case sender.thisThNoErrStop
                Case True
                    If errThColl.Count >= 1 Then
                        CType(errThColl.Item(1), MyDownThread).startdown()
                        errThColl.Remove(1)
                    End If
                Case False
                    If sender.thErrCount > 3 Then
                        'Debug.WriteLine(sender.MyThreadData.startPos & " :" & Now.ToString)
                        errThColl.Add(sender)
                        Debug.WriteLine("出错线程总计：　" & errThColl.Count.ToString)
                        If errThColl.Count = Me.thColl.Count Then
                            Me.downError = True
                            'Me.UpTimer.Enabled = False
                        End If
                    Else
                        Debug.WriteLine("线程重试次数：" & sender.thErrCount.ToString & " 这个线程开始在：" & sender.MyThreadData.startPos & " :" & Now.ToString)
                        sender.startdown()
                        Exit Sub
                    End If
            End Select
            'Catch ex As Exception
            'Debug.WriteLine(ex.ToString & "########################")
            'End Try
        End If

        Me.closeTH -= 1
        If Me.closeTH = 0 Then
            Me.DownDone()
            ' Me.UpTimer.Enabled = False
            'Dim d As New AddWebBrowserCallBack(AddressOf Me.UpDate)
            'd.Invoke()
            'Me.m_TaskInfo.status = 9
            ' App.MainForm.ListView1.Items(Me.linkItemIndex).SubItems(0).Text = "10"
            'App.MainForm.ListView1.Items(Me.linkItemIndex).SubItems(6).Text = "0"
        End If
    End Sub
    Sub IniTaskInfo(ByVal url As String, ByVal savePathFilename As String, ByVal tAmount As Integer)
        Dim filesize As Long
        Dim req As Net.HttpWebRequest
        Try
            req = CType(Net.HttpWebRequest.Create(url), Net.HttpWebRequest)
            filesize = req.GetResponse.ContentLength
            If filesize < tAmount Then tAmount = CInt(filesize) '假如文件非常小
            '快速建立目标文件
            Using fs As System.IO.FileStream = IO.File.Create(savePathFilename)
                fs.Seek(filesize - 1, IO.SeekOrigin.End) '
                fs.WriteByte(0)
            End Using
            While Not My.Computer.FileSystem.FileExists(savePathFilename)
                System.Threading.Thread.Sleep(100) '等一下
            End While
            req.Abort()
        Catch ex As Exception
            RaiseEvent errorInfo()
            MessageBox.Show(ex.Message)
        End Try
        '根据线程数初始化数组
        Dim tStartPos() As Long = New Long(tAmount - 1) {} '每个线程接收文件的起始位置
        Dim tNowPos() As Long = New Long(tAmount - 1) {}
        Dim tEndPos() As Long = New Long(tAmount - 1) {} '每个线程接收文件的长度
        '//计算每个线程应该接收文件的大小
        Dim filePartSize As Integer = CInt(filesize / tAmount) '文件每部分长度
        Dim fileRemainSize As Long = filesize - (filePartSize * tAmount) '剩余部分长度
        '//为数组赋值
        For i As Integer = 0 To tAmount - 1
            tStartPos(i) = filePartSize * i '每个线程接收文件的起始点
            tNowPos(i) = tStartPos(i)
            tEndPos(i) = tStartPos(i) + filePartSize - 1  '每个线程接收文件的长度
        Next
        tEndPos(tAmount - 1) += fileRemainSize '最后一部分要长一点1 or 2 byte
        ' 保存到数据库
        Dim sb As New System.Text.StringBuilder
        For j As Integer = 0 To tAmount - 1
            sb.Append("#" & tStartPos(j) & ":" & tNowPos(j) & ":" & tEndPos(j))
        Next
        Dim encoding As System.Text.Encoding = encoding.Unicode
        Dim b As Byte() = System.Text.Encoding.Unicode.GetBytes(sb.ToString.ToCharArray)