VB下载文件

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As LongSub command1_click()R = URLDownloadToFile(0, "http://2ting.rm130.com/99123-6/0007/8.Wma", "c:/8.Wma", 0, 0)End Sub

 

 

可能是你的下载地址已经无法访问，而迅雷下载采用了类似盗链的方式从别的地方下载的，所以能下载成功。
再了，不推荐使用URLDOWNTOFILE函数，多数木马使用这个API，可能会被杀软K。。

我原来写过一个用WinNet API写的下载Function

http://www.80ht.cn/wp-content/uploads/2010/02/vb_downloadfile.zip

 

Private Const scUserAgent = "BF"Private Const INTERNET_OPEN_TYPE_DIRECT = 1Private Const INTERNET_OPEN_TYPE_PROXY = 3Private Const INTERNET_FLAG_RELOAD = &H80000000Private Const HTTP_QUERY_CONTENT_LENGTH = 5Private Const BufferSizeA& = 512Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As LongPrivate Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As IntegerPrivate Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As IntegerPrivate Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As LongPrivate Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer'下载保存到文件Function DownFile(ByVal strURL As String, ByVal strPath As String, Optional ByVal ReMove As Boolean) As BooleanOn Error GoTo ERR: Dim hOpen As Long, hFile As Long, sBuffer() As Byte, Ret As Long hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) If hOpen = 0 Then DownFile = False: Exit Function hFile = InternetOpenUrl(hOpen, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&) If hFile = 0 Then DownFile = False: Exit Function If Dir(strPath) <> "" Then If ReMove Then Kill strPath Else DownFile = False Exit Function End If End If ' If Dir(strPath) <> "" Then' If (MsgBox("目标文件存在，是否覆盖？", vbYesNo)) = vbYes Then' Kill strPath' Else' DownFile = False' Exit Function' End If' End If Open strPath For Binary As #1 ReDim sBuffer(999) Do InternetReadFile hFile, sBuffer(0), 1000, Ret If Ret <> 0 Then If Ret < 1000 Then ReDim Preserve sBuffer(Ret - 1) Put #1, , sBuffer Else Exit Do End If DoEvents Loop Close #1 InternetCloseHandle hFile InternetCloseHandle hOpen DownFile = True Exit Function ERR: DownFile = FalseEnd Function'测试链接的有效性Function TestUrl(ByVal strURL As String) As BooleanOn Error GoTo ERR: Dim hOpen As Long, hFile As Long, sBuffer() As Byte, Ret As Long hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) If hOpen = 0 Then TestUrl = False: Exit Function hFile = InternetOpenUrl(hOpen, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&) If hFile = 0 Then TestUrl = False: Exit Function ReDim sBuffer(999) InternetReadFile hFile, sBuffer(0), 1000, Ret If Ret > 0 Then TestUrl = True Else TestUrl = False End If InternetCloseHandle hFile InternetCloseHandle hOpen Exit Function ERR: TestUrl = FalseEnd Function'获取链接文件大小Function GetFileByte(ByVal strURL As String) On Error GoTo ERR: Dim sBuffer As String * BufferSizeA Dim hHttpQueryInfo& Dim hInternetOpen As Long Dim hInternetOpenUrl& Dim hFile As Long Dim Ret As Long hInternetOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) hInternetOpenUrl = InternetOpenUrl(hInternetOpen, strURL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0) hHttpQueryInfo = HttpQueryInfo(hInternetOpenUrl, HTTP_QUERY_CONTENT_LENGTH, ByVal sBuffer, Len(sBuffer), 0) sBuffer = IIf(hHttpQueryInfo, Left(sBuffer, Len(sBuffer)), "0") GetFileByte = CLng(sBuffer) InternetCloseHandle hInternetOpen Exit Function ERR: GetFileByte = -1End Function

 

http://www.vbgood.com/viewthread.php?tid=83553