查看: 36  |  回复: 0
  VB6 代码管家-下载文件
楼主
发表于 2024年12月8日 21:40
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

Private Sub Form_Load()
    URLDownloadToFile 0, "下载的路径", "保存路路径", 0, 0
End Sub

'================================================用系统API下载文件================================================

Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long

Private Sub Form_Load()
    Call DoFileDownload(StrConv("http://73.duote.org/qqandngjhyb.zip", vbUnicode))
End Sub

'================================================用IE组件下载文件================================================
Public Function Download_File(ByVal Url As String, ByVal Save_Path As String) As Variant
    On Error GoTo CHUCUO:
    Dim XMLHTTP As Object
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "Get", Url, True
    XMLHTTP.send
    Dim ShuZu() As Byte
    ShuZu = XMLHTTP.ResponseBody
    
    Open Save_Path For Binary As #1
    Put #1, , ShuZu
    Close #1
    
    Set XMLHTTP = Nothing
    Exit Function
CHUCUO:
    Set XMLHTTP = Nothing
    Download_File = ""
End Function

Private Sub Command1_Click() '调用方法
    Call Download_File("http://dlsw.baidu.com/sw-search-sp/soft/bc/12002/8uftp_setup3.8.1.1.2542643468.exe", "C:\1.exe")
End Sub

'================================================用XMLHTTP组件下载文件================================================

'方法:工程 - 引用-Microsoft WinHTTP Services, version 5.1
'注意:因为某些网站的限制,下载某些文件时,须要填写正确的“WinHttp.SetRequestHeader”文件头才能下载
Public Function Download_File(ByVal Url As String, ByVal Save_Path As String) As Variant
    On Error GoTo CHUCUO:
    Dim WinHttp As WinHttp.WinHttpRequest
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttp.SetTimeouts 30000, 30000, 30000, 30000
    WinHttp.Open "GET", Url, True
    WinHttp.SetRequestHeader "Accept-Language", "zh-cn"
    WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    WinHttp.Send
    WinHttp.WaitForResponse
    Dim ShuZu() As Byte
    ShuZu = WinHttp.ResponseBody
    Open Save_Path For Binary As #1
    Put #1, , ShuZu
    Close #1
    Exit Function
CHUCUO:
    Set WinHttp = Nothing
    Download_File = ""
End Function

Private Sub Command1_Click() '调用方法
    Call Download_File("http://dlsw.baidu.com/sw-search-sp/soft/bc/12002/8uftp_setup3.8.1.1.2542643468.exe", "C:\1.exe")
End Sub

'================================================用WINHTTP组件下载文件================================================


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2024 MaNongKu.com