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 Long Sub command1_click() R = URLDownloadToFile(0,"http://2ting.rm130.com/99123-6/0007/8.Wma","c:/8.Wma",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 = 1 Private Const INTERNET_OPEN_TYPE_PROXY = 3 Private Const INTERNET_FLAG_RELOAD = &H80000000 Private Const HTTP_QUERY_CONTENT_LENGTH = 5 Private Const BufferSizeA& = 512 Private 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 Long Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long,ByRef sBuffer As Byte,ByVal lNumBytesToRead As Long,lNumberOfBytesRead As Long) As Integer Private 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 Long Private 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 Boolean On Error GoTo ERR: Dim hOpen As Long,hFile As Long,sBuffer() As Byte,Ret As Long hOpen = InternetOpen(scUserAgent,INTERNET_OPEN_TYPE_DIRECT,vbNullString,0) If hOpen = 0 Then DownFile = False: Exit Function hFile = InternetOpenUrl(hOpen,strURL,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 = False End Function '测试链接的有效性 Function TestUrl(ByVal strURL As String) As Boolean On Error GoTo ERR: Dim hOpen As Long,0) If hOpen = 0 Then TestUrl = False: Exit Function hFile = InternetOpenUrl(hOpen,ByVal 0&) If hFile = 0 Then TestUrl = False: Exit Function ReDim sBuffer(999) InternetReadFile hFile,Ret If Ret > 0 Then TestUrl = True Else TestUrl = False End If InternetCloseHandle hFile InternetCloseHandle hOpen Exit Function ERR: TestUrl = False End 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,0) hInternetOpenUrl = InternetOpenUrl(hInternetOpen,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 = -1 End Function

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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!