'The download library notifies the errors that occurred during the download process through this function
Private Sub FDown_Error(ByVal lIndex, ByVal lErrorCode)
On Error Resume Next
If blnDStop = True Then
End If
("DownState").innerText = lErrorCode
End Sub
'=============================================================================================================================================================
'FDown event module ends
'=============================================================================================================================================================
' ============================================
' Get the extension based on the path
' ============================================
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
'=============================================================================================================================================================
'Function function module start
'=============================================================================================================================================================
'Download remote URL data
Function Download_Text(ByVal MetHod, ByVal Url, ByVal Charset, ByVal Async, ByVal Referer, ByVal Cookie)
On Error Resume Next
If Referer = "" Then Referer = Url
= 1
= MetHod
= Url
= Charset
= Async
= "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1)"
= Referer
= Cookie
= 3
End Function
'Download remote URL file to local
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 (SavePath & "\" & Filename) = False Then
'Download_File = False
'Exit Function
'End If
= 0
= MetHod
= Url
= SavePath
= Filename
= Async
= UserAgent
= Referer
= Cookie
= 3
Download_File =
End Function
'Download remote URL header information
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
= 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
= 1
= MetHod
= Url
= Async
= UserAgent
= Referer
= Cookie
= 3
Download_Head = (Async, SAsync)
End Function
'Download Cookies
Function Download_Cookie(ByVal MetHod, ByVal Url, ByVal Referer, ByVal UserAgent, ByVal Cookie, ByVal N)
On Error Resume Next
If Referer = "" Then Referer = Url
= 0
= MetHod
Download_Cookie = (Url,Referer,UserAgent,Cookie,N)
End Function
'Start the collection
Sub StartCai()
CAIType = "C1"
Download_Text 0, ("SpecialURL").value, "gb2312", False, "", ""
End Sub
'Download music
Sub GetMusic()
If MusicPtr>MusicCount Then
MsgBox "Download all!"
Exit Sub
End If
MusicPlayer = "http:///play/" & MusicURLArr(MusicPtr) & ".htm"
Download_Text 0, MusicPlayer, "gb2312", False, "", ""
End Sub
</Script>
<br />
<input type='button' value=' start collection ' onclick='StartCai()'>
</BODY>
</HTML>
Previous page1234Read the full text