VB如何下载图片

你都看了它的属性，那么你应该看到了它的地址
用inet控件直接取它的地址下载它就可以了
也可用winsock、webbrowser、甚至API等都可以
代码你点这里的搜索就可以搜索到了。我也是初学者，所以我建议你多用搜索，这样知识增长快些全面些。：）

我用下面的代码下载，但下载的图片不全，有谁知道怎么回事情吗
Private Sub Command1_Click()
Dim strURL As String
Dim bData() As Byte      '数据变量
Dim intFile As Integer   '可用文件变量
strURL = "http://survey.news.sina.com.cn/auth_number.php?survey=b6aaf129adec6c2d7f8318cf9113673ff7d945"
intFile = FreeFile()      '将 intFile 设置为未使用的文件
' OpenURL 方法的结果首先传入 Byte 数组，
'然后将 Byte 数组保存到磁盘。
bData() = Inet.OpenURL(strURL, icByteArray)
Open App.path & "\code.bmp" For Binary Access Write _
As #intFile
Put #intFile, , bData()
Close #intFile
Inet.Cancel
End Sub

图片下载不全？你是指你在硬盘上看到的内容不全还是无法用IMG控件显示？那个验证码图片是个PNG格式图片，我用代码下载没有问题，但不管理你存成什么文件名，它都是png格式，这个格式IMG控件无法显示的。如有其它问题，把inet.cancel屏掉再试试。

抄一段代码，ＬＺ看看
Option Explicit'用Winsock下载文件
'Author:Blueheart
'Homepage:http://www.bhdata.com
'Email:[email protected]
'欢迎交流Dim mintFile As Integer     '文件句柄
Dim mblnBegin As Boolean    '记录是否是第一次取得数据
Dim mlngDownSize As Long    '已下载的文件大小
Dim mlngTotalSize As Long   '文件大小
Dim mblnTimeOut As Boolean  '设置是否连接超时Private Sub Command1_Click()
    dlgMain.ShowSave

    If dlgMain.FileName <> "" Then
        txtSaveAs.Text = dlgMain.FileName
    End If

End SubPrivate Sub Command2_Click()
    If txtURL.Text = "" Then
        MsgBox "请输入文件URL路径！", vbCritical
        Exit Sub
    ElseIf txtSaveAs.Text = "" Then
        MsgBox "请指定保存位置！", vbCritical
        Exit Sub
    ElseIf Dir(txtSaveAs.Text) <> "" Then
        If MsgBox("文件" & txtSaveAs.Text & "已经存在!" & vbCrLf & vbCrLf & "是否替换？", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If

    DisEnableControl        '使相关控件失效

    With Winsock1
        '初始相关数据
        pgbMain.Value = 0
        mlngDownSize = 0
        mlngTotalSize = 0

        If .State <> sckClosed Then .Close
        .RemoteHost = URLHost(txtURL.Text)  '得到下载地址的服务器地址
        .RemotePort = 80            'http端口80

        mblnTimeOut = False
        Timer1.Interval = 5000      '设置超时为5秒
        Timer1.Enabled = True
        .Connect
        Me.Caption = "正在连接" & .RemoteHost & "..."
        Do While .State <> sckConnected And mblnTimeOut = False
            DoEvents
        Loop
        Timer1.Enabled = False
        If mblnTimeOut = True Then
            MsgBox "连接到" & .RemoteHost & "超时！", vbCritical
            EnableControl
            Exit Sub
        Else
            Dim strCommand As String
            Dim strWebPage As String

            strWebPage = txtURL.Text

            'HTTP协议请求
            strCommand = "GET " + strWebPage + " HTTP/1.0" + vbCrLf
            strCommand = strCommand + "Accept: */*" + vbCrLf
            strCommand = strCommand + "Accept: text/html" + vbCrLf
            strCommand = strCommand + vbCrLf

            mblnBegin = True    '设置为第一次取得文件数据状态
            Winsock1.SendData strCommand    '发送请求
        End If
    End With



End Sub
Private Function URLHost(ByVal strUrl As String)    '取得URL的服务器地址
    strUrl = LCase(strUrl)
    If Left(strUrl, 7) <> "http://" Then
        URLHost = Left(strUrl, InStr(strUrl, "/") - 1)
    Else
        URLHost = Mid(strUrl, 8, InStr(8, strUrl, "/") - 8)
    End If

End FunctionPrivate Sub Command3_Click()
    If MsgBox("确定取消下载？", vbQuestion + vbOKCancel) = vbOK Then
        On Error Resume Next
        Winsock1.Close
        Kill txtSaveAs.Text     '删除下载的文件
        EnableControl
    End If
End SubPrivate Sub Timer1_Timer()
    mblnTimeOut = True
    Timer1.Enabled = False
End SubPrivate Sub Timer2_Timer()
    Dim str1 As String


End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim bytData() As Byte
    Dim bytDataHeader() As Byte
    Dim strLine As String
    Dim intCrLf As Integer
    Dim nTempFile As Integer
    Dim strTempFile As String

    Winsock1.GetData bytData, vbArray + vbByte, bytesTotal '以二进制形式接送数据，这是关键

    If mblnBegin = True Then    '如果是首次接收文件
        mblnBegin = False

        '取得得到数据中的第一个空行,因为空行前面的是HTTP头，而非文件内容
        intCrLf = InStrB(bytData, ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10))

        bytDataHeader = MidB(bytData, 1, intCrLf - 1)

        nTempFile = FreeFile
        strTempFile = "c:\tmp85EER69e2534Ee8545sdf8.txt"
        Open strTempFile For Binary Access Write As #nTempFile      '因为是二进制数据，不好处理，所以将它保存为文本文件再处理，不知道有没有更好的方法？
        Put #nTempFile, , bytDataHeader
        Close #nTempFile

        Open strTempFile For Input As #nTempFile
        Line Input #nTempFile, strLine
        strLine = Mid(strLine, InStr(strLine, " ") + 1, 3)  '其中的第一行前三个字符就是HTTP应答结果，如果是非200，那就是不成功了。
        If strLine <> "200" Then
            Close #nTempFile
            Kill strTempFile    '删除临时文件
            MsgBox "文件不存在！下载失败！", vbCritical
            Winsock1.Close
            EnableControl
            Exit Sub
        End If

        Do While Left(strLine, 15) <> "Content-Length:" '直到有一行的开头是Content-Length，因为这一行保存了文件的字节数，通过这可以知道要下载的文件的大小
            Line Input #nTempFile, strLine
        Loop
        Close #nTempFile
        Kill strTempFile

        mintFile = FreeFile()
        Open txtSaveAs.Text For Binary Access Write As #mintFile

        mlngTotalSize = Val(Mid(strLine, InStr(strLine, ":") + 1)) + intCrLf + 3    '得到了文件的大小

        bytData = MidB(bytData, intCrLf + 4)    '这次得到的数据有一部分是文件内容

    End If

    Put #mintFile, , bytData        '写入要保存的文件中

    mlngDownSize = mlngDownSize + bytesTotal    '改变已下载的文件大小

    Me.Caption = "已下载" & Int((mlngDownSize / mlngTotalSize) * 100) & "%" '显示百分点

    pgbMain.Value = (mlngDownSize / mlngTotalSize) * 100    '进度条

    If mlngDownSize >= mlngTotalSize Then   '判断是否已完成下载
        Close #mintFile         '关闭文件
        Winsock1.Close
        MsgBox "下载完成！", vbInformation
        pgbMain.Value = 0
        Me.Caption = "用Winscok下载文件"
        EnableControl   '生效相关控件
    End If
End Sub
Private Sub EnableControl()     '生效相关控件
    txtURL.Enabled = True
    txtSaveAs.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = False
    Command1.Enabled = True
End Sub
Private Sub DisEnableControl()       '失效相关控件
    txtURL.Enabled = False
    txtSaveAs.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = True
    Command1.Enabled = False
End Sub

Dim weburl As String
Dim B() As Byte
weburl = "http://survey.news.sina.com.cn/auth_number.php?survey=b6aaf129adec6c2d7f8318cf9113673ff7d945"
B() = Inet1.OpenURL(weburl, icByteArray)
Open App.Path & ".\temp.png" For Binary Access Write As #1
Put #1, , B()
Close #1我是用这段代码下载的，下载后除了不能在IMG控件显示外没有任何其它问题。
其实和你的代码没有什么本质上区别。是否你连接那网站的网速有问题？INET默认连接时间1Min，超时连接会出现下载不完全的情况。

调试易

VB如何下载图片

解决方案 »