down.vb

基于Windows Mobile平台的网络蚂蚁下载工具

Public Class Down
    Private dd As Int32                     ' 记录已下载接受到的数据量
    Private st As Boolean
    Dim myReq As Net.HttpWebRequest         ' 发出网络资源请求
    Dim myRep As Net.HttpWebResponse        ' 接受服务器响应
    Dim ReadBytes As Int16 = 4095
    Dim Dtd As Threading.Thread             ' 工作线程

    Public Property inds() As Int32
        Get
            inds = dd
        End Get
        Set(ByVal Value As Int32)
            dd = Value
        End Set
    End Property

    Public Sub New()
        inds = -1
    End Sub

    Sub Start_down()
        Dtd = New Threading.Thread(AddressOf Starts)
        If dd < 0 Then Exit Sub
        Try
            st = False
            Dtd.Start()
        Catch ex As Exception
            MessageBox.Show("下载任务启动错误，请重新启动！", "MobileAnt Demo")
        End Try
    End Sub

    Sub Stop_down()
        st = True
    End Sub

    Private Sub Starts()
        If dd < 0 Or dd > JOBS.GetUpperBound(1) Then
            MessageBox.Show("程序发生错误，请重新启动！", "MobileAnt Demo")
            dd = -1
            Exit Sub
        End If
        Dim LAST_size As Int32 = JOBS(FileSizeOk, dd)
        JOBS(logs, dd) = ""
        'Dim pp As Net.IWebProxy
        Dim i As Int32
        '''''''''''''''''''''''''''
        Dim UU As Uri = Nothing
        Try
            UU = New Uri(JOBS(URL, dd))
        Catch ex As Exception

        End Try
        Try
            myReq = CType(Net.WebRequest.Create(UU), Net.HttpWebRequest)
        Catch ex As System.UriFormatException
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "地址格式错误：" & ex.Message & vbCrLf
            JOBS(State, dd) = ST_ERROR
            GoTo a3
        Catch ex As System.NotSupportedException
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "不支持的地址格式！" & ex.Message & vbCrLf
            JOBS(State, dd) = ST_ERROR
            GoTo a3
        Catch ex As System.Net.WebException
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "发生错误：" & ex.Message & vbCrLf
            JOBS(State, dd) = ST_ERROR
            GoTo A3
        Catch ex As Exception
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "发生未知错误：" & ex.InnerException.Message & vbCrLf
            JOBS(State, dd) = ST_ERROR
            GoTo A3
        End Try
        JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "准备开始下载（" & JOBS(URL, dd) & "）" & vbCrLf
        If JOBS(Login, dd) = 1 Then
            '加入认证
            myReq.PreAuthenticate = True
            If JOBS(Domain, dd) = "" Then
                myReq.Credentials = New Net.NetworkCredential(JOBS(UserName, dd), JOBS(PassWord, dd))
            Else
                myReq.Credentials = New Net.NetworkCredential(JOBS(UserName, dd), JOBS(PassWord, dd), JOBS(Domain, dd))
            End If
        End If
        If JOBS(FileSizeOk, dd) < Rollback Then
            JOBS(FileSizeOk, dd) = 0
        End If
        Dim Duan As Boolean = False
        If CInt(JOBS(FileSizeOk, dd)) > 0 And CInt(JOBS(FileSizeOk, dd)) < CInt(JOBS(RemoteFileSize, dd)) Then
            ' 加入断点续传，若未知文件大小不能续传！！
            myReq.AddRange(JOBS(FileSizeOk, dd) - Rollback)
            Duan = True
        End If
        myReq.Timeout = TIME_OUT
        ''''''''''''''''''''''''''''''''开始返回数据
        Try
            myRep = myReq.GetResponse()
        Catch Ex As System.Net.WebException
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "服务器返回错误，状态：" & Ex.Status & "。说明：" & Ex.Message & vbCrLf
            JOBS(ERR_times, dd) += 1
            JOBS(State, dd) = ST_ERROR
            GoTo a3
        End Try
        '获取实际文件名。没有使用重命名，而且没有收到任何数据。
        If JOBS(RenameD, dd) = 0 And JOBS(FileSizeOk, dd) = 0 Then
            Dim nname As String
            nname = myReq.Address.LocalPath.ToString
            i = nname.LastIndexOf("/")
            nname = nname.Substring(i + 1)
            If nname <> "" Then JOBS(FileName, dd) = JOBS(FileName, dd).Substring(0, JOBS(FileName, dd).LastIndexOf("\") + 1) & nname
        End If
        JOBS(RenameD, dd) = 1

        '获取HTTP的头作为日志。
        Dim hd As Net.WebHeaderCollection
        hd = myRep.Headers
        i = 0
        While i < hd.Count
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & " " & hd.Keys(i).ToString & "：" & hd(i) & vbCrLf
            i += 1
        End While
        '获取长度
        If Duan = False Then  'JOBS(RemoteFileSize, dd) = 0 And
            Try
                JOBS(RemoteFileSize, dd) = CInt(hd.GetValues("Content-Length")(0))
            Catch ex As System.NullReferenceException
                JOBS(RemoteFileSize, dd) = 0 '未知大小"
            End Try
        ElseIf Duan = True Then '断点续传检查上次的文件,大小和这次的是否一样！
            If IO.File.Exists(JOBS(FileName, dd)) = False Then
                JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "错误：未找到本地文件！！" & vbCrLf
                JOBS(State, dd) = ST_ERROR
                GoTo a2
            End If
            Dim f As New IO.FileInfo(JOBS(FileName, dd))
            If (CInt(JOBS(RemoteFileSize, dd)) - CInt(JOBS(FileSizeOk, dd) - Rollback) <> CInt(hd.GetValues("Content-Length")(0))) Or _
           (f.Length <> CInt(JOBS(FileSizeOk, dd))) Then
                JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "错误：本地文件大小与上次下载时不一致！" & vbCrLf
                GoTo a2
            End If
        End If
        '''''''''''''''开始下载
        Dim sr As IO.BinaryReader
        Try
            sr = New IO.BinaryReader(myRep.GetResponseStream)
        Catch ex As IO.IOException
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "读取远程数据发生错误！" & vbCrLf
            JOBS(State, dd) = ST_ERROR
            GoTo a2
        End Try

        Dim bb() As Byte
        Dim fs As System.IO.FileStream
        Try
            If Duan = True Then
                fs = New IO.FileStream(JOBS(FileName, dd), IO.FileMode.Open, IO.FileAccess.ReadWrite, IO.FileShare.None, ReadBytes + 1) '打开文件
                fs.Seek(JOBS(FileSizeOk, dd) - Rollback, IO.SeekOrigin.Begin)
                JOBS(FileSizeOk, dd) -= Rollback
            Else
                If IO.File.Exists(JOBS(FileName, dd)) Then
                    Dim xx As Windows.Forms.DialogResult
                    xx = MessageBox.Show("文件已经存在，要覆盖吗？" & vbCrLf & "No为重命名！", "MobileAnt Demo", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
                    If xx = Windows.Forms.DialogResult.Yes Then
                        IO.File.Delete(JOBS(FileName, dd))
                    ElseIf xx = Windows.Forms.DialogResult.No Then
                        i = JOBS(FileName, dd).LastIndexOf("\")
                        Dim dir As String = JOBS(FileName, dd).Substring(0, i)
                        Dim nn As String = JOBS(FileName, dd).Substring(i + 1)
                        i = nn.LastIndexOf(".")
                        nn = nn.Substring(0, i) & "_*" & nn.Substring(i)
                        Dim dirs As String() = System.IO.Directory.GetFiles(dir, nn)
                        i = dirs.Length + 1
                        nn = dir & "\" & nn
                        dir = nn.Replace("_*", "_" & CStr(i))
                        If IO.File.Exists(dir) Then
                            i = -1
                            Do
                                i += 1
                                dir = nn.Replace("_*", "_" & CStr(i))
                            Loop Until IO.File.Exists(dir) = False
                            JOBS(FileName, dd) = dir
                        Else
                            JOBS(FileName, dd) = dir
                        End If
                    ElseIf xx = Windows.Forms.DialogResult.Cancel Then
                        Throw New IO.IOException("文件已经存在！没有覆盖！")
                    End If
                End If
                JOBS(FileSizeOk, dd) = 0
                fs = New IO.FileStream(JOBS(FileName, dd), IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None, ReadBytes + 1)  '生成文件
            End If
        Catch ex As IO.IOException
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "生成下载文件时错误：" & ex.Message & vbCrLf
            JOBS(State, dd) = ST_ERROR
            GoTo a2
        End Try
        Try
            Do
                bb = sr.ReadBytes(ReadBytes + 1)
                JOBS(FileSizeOk, dd) += bb.Length
                fs.Write(bb, 0, bb.Length)
                If bb.Length <= 0 Then
                    JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "下载完成" & vbCrLf
                    If JOBS(RemoteFileSize, dd) = 0 Then JOBS(RemoteFileSize, dd) = JOBS(FileSizeOk, dd)
                    JOBS(State, dd) = ST_OK_END
                    Exit Do
                End If
                If st = True Then
                    fs.Flush()
                    JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "中断下载！" & vbCrLf
                    JOBS(State, dd) = ST_STOP
                    Exit Do
                End If
            Loop
        Catch ex As Exception
            JOBS(logs, dd) &= TimeOfDay.ToLongTimeString & "接收数据时错误：" & ex.Message & vbCrLf
            JOBS(State, dd) = ST_ERROR
        End Try
A1:     fs.Close()
A2:     myRep.Close()
A3:     i = dd
        dd = -1
        If JOBS(RemoteFileSize, i) > JOBS(FileSizeOk, i) And JOBS(State, i) <> ST_STOP Then
            If AutoRestart = 1 And JOBS(FileSizeOk, i) - LAST_size > 0 Then
                dd = i
                Call Start_down()
            End If
        End If
        '下载完成''''''''''''''''''''''''''''''''''''''''''''''''''
    End Sub
End Class