'下載庫通過該函數(shù)通知下載過程中發(fā)生的錯誤
Private Sub FDown_Error(ByVal lIndex, ByVal lErrorCode)
    On Error Resume Next
    If blnDStop = True Then
        FDown.bStop
    End If

    document.getElementById("DownState").innerText = lErrorCode

End Sub
'=============================================================================================================================================================
'FDown事件模塊 結(jié)束
'=============================================================================================================================================================

' ============================================
' 根據(jù)路徑獲取擴(kuò)展名
' ============================================
Public Function GetFileExt(ByVal FullPath)
    On Error Resume Next
    Dim pos, pvs
    pos = InStrRev(FullPath, ".")
    pvs = InStrRev(FullPath, "?") - pos
    If pvs < pos Then pvs = InStrRev(FullPath, "?")
    If pos > 0 Then
        If pvs > 0 Then
            GetFileExt = Mid(FullPath, pos, pvs)
        Else
            GetFileExt = Mid(FullPath, pos)
        End If
    End If
End Function

'=============================================================================================================================================================
'功能函數(shù)模塊 開始
'=============================================================================================================================================================
'下載遠(yuǎn)程URL數(shù)據(jù)
Function Download_Text(ByVal MetHod, ByVal Url, ByVal Charset, ByVal Async, ByVal Referer, ByVal Cookie)
    On Error Resume Next
    If Referer = "" Then Referer = Url
    FDown.Init
    FDown.DownLoadType = 1
    FDown.MetHod = MetHod
    FDown.Url = Url
    FDown.Charset = Charset
    FDown.SyncMode = Async
    FDown.UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1)"
    FDown.URLReferer = Referer
    FDown.Cookie = Cookie
    FDown.FailRetryTimes = 3
    FDown.DownLoad
End Function

'下載遠(yuǎn)程URL文件到本地
Function Download_File(ByVal MetHod, ByVal Url, ByVal SaveFile, ByVal Async, ByVal Referer, ByVal Cookie)
    'On Error Resume Next
    Dim UserAgent
    Dim SavePath
    Dim Filename
    If Referer = "" Then Referer = Url
    SavePath = Mid(SaveFile, 1, InStrRev(SaveFile, "\") - 1)
    Filename = Mid(SaveFile, InStrRev(SaveFile, "\") + 1, Len(SaveFile))

    Select Case LCase(GetFileExt(Url))
        Case ".mp3", ".wma", ".wmv", ".wav", ".avi", ".mpeg", ".mpg", ".mid"
        UserAgent = "NSPlayer/10.0.0.3708 WMFSDK/10.0"
        Case ".rm", ".rmvb"
        UserAgent = "RMA/1.0 (compatible; RealMedia) "
        Case Else
        UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1)"
    End Select

    'If FDown.CreateFolders(SavePath & "\" & Filename) = False Then
        'Download_File = False
        'Exit Function
    'End If
FDown.Init
    FDown.DownLoadType = 0
    FDown.MetHod = MetHod
    FDown.Url = Url
    FDown.SavePath = SavePath
    FDown.Filename = Filename
    FDown.SyncMode = Async
    FDown.UserAgent = UserAgent
    FDown.URLReferer = Referer
    FDown.Cookie = Cookie
    FDown.FailRetryTimes = 3

    Download_File = FDown.DownLoad

End Function

'下載遠(yuǎn)程URL頭部信息
Function Download_Head(ByVal MetHod, ByVal Url, ByVal Async, ByVal Referer, ByVal Cookie, ByVal SAsync)
    On Error Resume Next
    Dim UserAgent
    If Referer = "" Then Referer = Url
    DownForm.Caption = Url
    Select Case LCase(GetFileExt(Url))
        Case ".mp3", ".wma", ".wmv", ".wav", ".avi", ".mpeg", ".mpg", ".mid"
        UserAgent = "NSPlayer/9.0.0.2991 WMFSDK/9.0 "
        Case ".rm", ".rmvb"
        UserAgent = "RMA/1.0 (compatible; RealMedia) "
        Case Else
        UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1)"
    End Select

    FDown.Init
    FDown.DownLoadType = 1
    FDown.MetHod = MetHod
    FDown.Url = Url
    FDown.SyncMode = Async
    FDown.UserAgent = UserAgent
    FDown.URLReferer = Referer
    FDown.Cookie = Cookie
    FDown.FailRetryTimes = 3
    Download_Head = FDown.DownLoadHead(Async, SAsync)
End Function

'下載Cookie
Function Download_Cookie(ByVal MetHod, ByVal Url, ByVal Referer, ByVal UserAgent, ByVal Cookie, ByVal N)
    On Error Resume Next
    If Referer = "" Then Referer = Url
    FDown.Init
    FDown.DownLoadType = 0
    FDown.MetHod = MetHod
    Download_Cookie = FDown.DownloadCookie(Url,Referer,UserAgent,Cookie,N)
End Function

'開始采集
Sub StartCai()
        CAIType = "C1"
        Download_Text 0, document.getElementById("SpecialURL").value, "gb2312", False, "", ""
End Sub

'下載音樂
Sub GetMusic()
        If MusicPtr>MusicCount Then
                MsgBox "全部下載完成!"
                Exit Sub
        End If
        MusicPlayer = "http://www.520music.com/play/" & MusicURLArr(MusicPtr) & ".htm"
        Download_Text 0, MusicPlayer, "gb2312", False, "", ""
End Sub
</Script>
<br />
<input type='button' value=' 開始采集 ' onclick='StartCai()'>
</BODY>
</HTML>

最新評論