事情是这样的:
我需要一个代码,支持网站上下载附件,比如http://aaa.com/attach.php?id=9999这种非断点续传和http://aaa.com/a.rar这种可断点续传的。使用单线程,winsock组件。按道理说,这个很简单的,但现在我遇到了麻烦。麻烦在于:Winsock1_DataArrival 这个事件是在接收服务器信息时运行,但我使用httpanalyer监控,发现服务器已经不向软件发送数据了,但这个Winsock1_DataArrival 事件还在运行。有时候能多运行6-10次,最多时能运行37次。上代码
Dim ip As Integer '这个是计数器,不是记录IP的'---------------------------------------------------------
'winsocks相关
Dim HeaderReceived As Boolean       '判断是否得到header
Dim SaveFileCompleted As Boolean    '判断文章是否下载完毕
Dim oTotalLenght As Long            '总长度
Dim oAlreadyLenght As Long          '已经下载的长度,去掉header的长度
Dim oRemainingLenght As Long        '剩余的长度
Dim oSaveFileLoad As String
Dim oSaveFileName As String
'---------------------------------------------------------Private Sub DownLoadFromWinSock()
    Dim GetUrl As String
 '初始化之前的数据
    HeaderReceived = False
    SaveFileCompleted = True
    oTotalLenght = 0
    oSaveFileLoad = ""
    oSaveFileName = ""
    
    FileUrl = GetFullUrl(FileUrl)  '注意:这里的FILEURL是下载链接
    GetUrl = GetUrlClearHttp(FileUrl)
   ' Text5.Text = FileUrl
    If InStr(1, GetUrl, "/") Then  '接收文件的文件名
        FileString = Mid(GetUrl, InStr(1, GetUrl, "/"))
        FileHost = Mid(GetUrl, 1, InStr(1, GetUrl, "/") - 1)
    Else
        FileString = "/"
        FileHost = GetUrl
    End If
    
    Winsock1.RemoteHost = FileHost '设置连接的网址
    Winsock1.RemotePort = 80 '设置要连接的远程端口号
    Winsock1.Connect '返回与远程计算机的连接。
End SubPrivate Sub Winsock1_Connect()
    Dim strCommand As String
    
'当一个 Connect 操作完成时发生
'On Error Resume Next
DisEnableControl    '相关控件失效
strCommand = "GET " + FileString + " HTTP/1.1" + vbCrLf 'GET 为FTP命令 取得文件
strCommand = strCommand + "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*" + vbCrLf
strCommand = strCommand + "Referer: " + RefererUrl + vbCrLf
strCommand = strCommand + "Accept-Language: zh-cn" + vbCrLf
strCommand = strCommand + "Accept-Encoding: gzip, deflate" + vbCrLf
strCommand = strCommand + "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727)" + vbCrLf
strCommand = strCommand + "Host: " + FileHost + vbCrLf
strCommand = strCommand + "Connection: Keep-Alive" + vbCrLf
strCommand = strCommand + vbCrLf
Text4.Text = strCommand
Winsock1.SendData strCommand '给远程计算机发送数据End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long) '取得数据时产生该事件
On Error Resume Next
DoEvents
Sleep 200
DoEventsip = ip + 1 '奇怪的就是这里,在已经弹出“下载完成”的情况下,这里按道理应该就结束了,但他还要继续循环
Text5.Text = Text5.Text & " " & ip'所有变量以o开头
Dim oData() As Byte                 '接收的二进制数组
Dim oHtml As String                 '接收的全部内容
Dim oHeader As String               'header部分
Dim oHeadLines() As String         'header部分分割为数组
Dim oHeadLine As Variant              '数组的每一段
Dim oBody As String                 '正文部分
Dim oPos As Long                    '断点位置
Dim i As Long                       '用于循环
Dim fnum As Integer
ReDim oData(bytesTotal)Winsock1.GetData oData, vbArray + vbByte, bytesTotal
oAlreadyLenght = oAlreadyLenght + bytesTotalIf Not HeaderReceived Then          '如果头文件没有找到
    oHtml = oHtml & StrConv(oData, vbUnicode)           'ohtml继续接收数据
    oPos = InStr(1, oHtml, vbCrLf & vbCrLf)             '字符串状态下的断点位置
    If oPos Then
        HeaderReceived = True                           '已经获得了头文件
        oHeader = Left(oHtml, oPos - 1)
        oHeadLines = Split(oHeader, vbCrLf)               '分割header
        '以下检查header中从服务器返回状态
        If InStr(1, oHeadLines(0), "40") Then       '40x错误
            Winsock1.Close
            MsgBox "文件不存在或权限不足!", vbInformation
            Exit Sub
        ElseIf InStr(1, oHeadLines(0), "302") Then  '302跳转
            For Each oHeadLine In oHeadLines
                If InStr(1, oHeadLine, "Location:") Then
                    
                    FileUrl = ComLoadUrl(Mid(oHeadLine, InStr(1, oHeadLine, " ") + 1), FileUrl)
                    '这里解决302时,相对链接转变为绝对链接的问题
                Exit For
                End If
            Next
            Winsock1.Close  '关闭本次链接,等待重新建立连接
            DownLoadFromWinSock '重定向后再次链接
            Exit Sub
        ElseIf InStr(1, oHeadLines(0), "200") Then  '正确接收数据
            SaveFileCompleted = False   '文件是否接收完成
        
            For Each oHeadLine In oHeadLines
                If InStr(1, oHeadLine, "Content-LENGTH:") Then  '接收文件的总长度
                    oTotalLenght = CLng(Mid(oHeadLine, InStr(1, oHeadLine, " ") + 1))
                End If
                
                If InStr(1, oHeadLine, "filename=") Then  '接收文件的文件名
                    oSaveFileName = Mid(oHeadLine, InStr(1, oHeadLine, "filename=") + 9)
                End If
            Next
            
            '如果不是附件下载的方式,则直接获取文件名
            If oSaveFileName = "" Then
                oSaveFileName = FileUrl
                If InStr(1, oHeadLine, "?") Then  '接收文件的文件名
                    oSaveFileName = Mid(FileUrl, 1, InStr(1, FileUrl, "?"))
                End If
                oSaveFileName = Mid(oSaveFileName, InStrRev(oSaveFileName, "/"))
            End If
            
            oSaveFileLoad = GetFileLoad(oSaveFileName)
            
            
            oPos = 0    '初始化断点位置,从数组中取值,避免汉字造成的大小与真实值不符
            For i = 0 To UBound(oData) - 3
                If oData(i) = 13 And oData(i + 1) = 10 And oData(i + 2) = 13 And oData(i + 3) = 10 Then
                    oPos = i + 4
                    Exit For
                End If
            Next
            
            If oPos = 0 And oData(0) = 13 And oData(1) = 10 Then
                oPos = 2
            End If
            
            oAlreadyLenght = oAlreadyLenght - oPos  '   已经下载的长度
            oRemainingLenght = oTotalLenght - oAlreadyLenght    '剩余的下载长度
        Else
            Winsock1.Close
            MsgBox "服务器错误", vbInformation
            
            Exit Sub
        End If
    Else
        oAlreadyLenght = 0
    End If
End IfIf HeaderReceived And (Not SaveFileCompleted) Then 'HeaderReceived 接收文件头  SaveFileCompleted 下载文章完成
    fnum = FreeFile
    Open oSaveFileLoad For Binary Access Write As #fnum  '打开文件
    If LOF(fnum) > 0 Then
        Seek #fnum, LOF(fnum) + 1
    End If
    
    If oPos > 0 Then
    
        For i = oPos To UBound(oData)
        Put #fnum, , oData(i) '写入要保存的文件中
        Next
    Else
        Put #fnum, , oData()
    End If
    
    
    If oAlreadyLenght >= oTotalLenght Then
'按道理说,当下载完成后,关闭了winsock和关闭了文件,这里就应该直接跳出 sub 了,但我这里没有,所以不得不设置一个 savefilecompleted 阻止继续程序继续向文件写数据。
'而且,On Error Resume Next注释掉就会出现错误。
'我就想知道为什么??        SaveFileCompleted = True
        Winsock1.Close
        Close #fnum
        
        MsgBox "下载完成!", vbInformation
        EnableControl
    End If
End IfReDim oData(1)
End Sub

解决方案 »

  1.   

    应该是 http://topic.csdn.net/t/20061217/20/5236993.html 帖子中描述的情形,可惜不知道如何解决。
      

  2.   

    Connection: Keep-Alive,是不是应该改成Connection: Close,在不知道文件长度的情况下,传完了整个文件服务器才会关闭连接。而且VB的这个控件,本来就是这样的,已经关闭了连接,还会有数据传递事件,可能是因为TCP协议本来就是要把数据分成很多块,有的先到,有的后到,甚至于产生Winsock1.close事件的信号可能先行到达.应当以文件长度来算文件是否传完。
      

  3.   

    用了 Connection: Close ,还是不行。
    这可麻烦了,因为经常要用这软件下载一些较大的文件。如果服务器发送的时候不是按先后顺序,那接收后怎么保存啊?头痛了。
    连13M的迅雷都下载不回来,真是讨厌。
    兄弟们写这个的时候都用了什么组件啊?