最近想编一个四六级查询的登录器，具体网址是http://cet.99sushe.com/但是在识别码识别时遇到了问题，这个网站的识别码地址是"http://cet.99sushe.com/validatecode?v=Mon Mar 29 " & Right(Time, 8) & " UTC+0800 2010“ 用Downloadtofile 下载的识别码图片不能被VB识别，加载不到picturebox里面，说图片无效，很是郁闷，用电脑另存为存的同样的图片就能识别，到底是怎么回事呀，如何解决，或者怎么将下载图片转换一下？
还有一种情况是：html代码中禁止了图片缓存，当‘另存为’时，浏览器只能保存bmp格式的图片！你应该在浏览器中打开网页时，在图片上点鼠标右键→属性，从图片的URL中看源图片的格式，这样才可靠些。
（当然也不是“百分百的靠谱”）
需要第三方控件或自己加入代码处理（代码网上可以找到，搜索一下吧）。
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type
Private Type EncoderParameters
count As Long
Parameter As EncoderParameter
End Type
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, id As GUID) As Long
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
'*************************************************************************
'** 作 者 ： unknown
'** 函 数 名 ： SavePic
'** 输 入 ： pic(StdPicture) - 图象句柄
'** ： FileName(String) - 保存路径
'** ： Quality(Byte) - JPG图象质量
'** ： TIFF_ColorDepth(Long) - TTF格式的颜色深度
'** ： TIFF_Compression(Long) - TTF格式的压缩比
'** 输 出 ： 无
'** 功能描述 ： 把图象保存为JPG、TIFF、PNG、GIF、BMP格式
'** 日 期 ：
'** 修 改 人 ： laviewpbt
'** 日 期 ： 2005-10-23 14.43.52
'** 版 本 ： Version 1.2.1
'*************************************************************************
Public Sub SavePic(ByVal pict As StdPicture, ByVal FileName As String, PicType As String, _
Optional ByVal Quality As Byte = 80, _
Optional ByVal TIFF_ColorDepth As Long = 24, _
Optional ByVal TIFF_Compression As Long = 6)
Screen.MousePointer = vbHourglass
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
Dim aEncParams() As Byte
On Error GoTo ErrHandle:
tSI.GdiplusVersion = 1 ' 初始化 GDI+
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then ' 从句柄创建 GDI+ 图像
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters '初始化解码器的GUID标识
Select Case PicType
Case ".jpg"
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
tParams.count = 1 ' 设置解码器参数
With tParams.Parameter ' Quality
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID ' 得到Quality参数的GUID标识
.NumberOfValues = 1
.type = 4
.Value = VarPtr(Quality)
End With
ReDim aEncParams(1 To Len(tParams))
Call CopyMemory(aEncParams(1), tParams, Len(tParams))
Case ".png"
CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
ReDim aEncParams(1 To Len(tParams))
Case ".gif"
CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
ReDim aEncParams(1 To Len(tParams))
Case ".tiff"
CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
tParams.count = 2
ReDim aEncParams(1 To Len(tParams) + Len(tParams.Parameter))
With tParams.Parameter
.NumberOfValues = 1
.type = 4
CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID ' 得到ColorDepth参数的GUID标识
.Value = VarPtr(TIFF_Compression)
End With
Call CopyMemory(aEncParams(1), tParams, Len(tParams))
With tParams.Parameter
.NumberOfValues = 1
.type = 4
CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID ' 得到Compression参数的GUID标识
.Value = VarPtr(TIFF_ColorDepth)
End With
Call CopyMemory(aEncParams(Len(tParams) + 1), tParams.Parameter, Len(tParams.Parameter))
Case ".bmp" '可以提前写保存为BMP的代码，因为并没有用GDI+
SavePicture pict, FileName
Screen.MousePointer = vbDefault
Exit Sub
End Select
lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, aEncParams(1)) '保存图像
GdipDisposeImage lBitmap ' 销毁GDI+图像
End If
GdiplusShutdown lGDIP '销毁 GDI+
End If
Screen.MousePointer = vbDefault
Erase aEncParams
Exit Sub
ErrHandle:
Screen.MousePointer = vbDefault
MsgBox "在保存图片的过程中发生错误:" & vbCrLf & vbCrLf & "错误号: " & Err.Number & vbCrLf & "错误描述: " & Err.Description, vbInformation Or vbOKOnly, "错误"
End Sub
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End TypePrivate Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal Token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function URLOpenBlockingStream Lib "urlmon" Alias "URLOpenBlockingStreamA" (ByVal pCaller As Long, ByVal szURL As String, ppStream As Long, ByVal dwResv As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GdipCreateBitmapFromStream Lib "gdiplus" (ByVal Stream As Long, Bitmap As Long) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal m_Image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal m_Image As Long, Height As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal Hdc As Long, Graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Private Sub Command1_Click()
Dim Url As String
Dim Stream As Long
Dim Image As Long
Dim Width As Long
Dim Height As Long
Dim Graphics As Long
Dim Token As Long
Dim Gdip As GdiplusStartupInput
Gdip.GdiplusVersion = 1
GdiplusStartup Token, Gdip
Url = "http://cet.99sushe.com/validatecode?v=Mon Mar 29 " & Right(Time, 8) & " UTC+0800 2010"
URLOpenBlockingStream ObjPtr(Me), Url, Stream, 0, 0
GdipCreateBitmapFromStream Stream, Image
GdipGetImageWidth Image, Width
GdipGetImageHeight Image, Height
GdipCreateFromHDC Me.Hdc, Graphics
GdipDrawImageRectRectI Graphics, Image, 0, 0, Width, Height, 0, 0, Width, Height, 2, 0, 0, 0
GdipDeleteGraphics Graphics
GdiplusShutdown Token
End Sub
之前。
这个要简单些Private Sub Form_Load()
WebBrowser2.Navigate "http://cet.99sushe.com/validatecode?v=Mon Mar 29 " & Right(Time, 8) & " UTC+0800 2010"
end sub
Private Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim I As Object, CR As Object
For Each I In WebBrowser2.Document.All
If I.tagName = "IMG" Then '判断一下ID就行了,这里是判断ID=vcodeImg的那个验证码.
Set CR = WebBrowser2.Document.body.createControlRange() '设置选区
CR.Add I '添加选区
CR.execCommand ("Copy") '复制
Set Picture1.Picture = Clipboard.GetData()
End If
Next
end sub