VB 抓取网站验证码图片

VB 抓取网站验证码图片
2010年05月20日
　　方法一：使用XMLHTTP
　　Public Function GetCheckCode()
　　Dim xmlHttp As Object
　　Dim Pic
　　Dim PicData As Object
　　Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
　　Set PicData = CreateObject("Adodb.Stream")
　　xmlHttp.open "get", "http://www.pceggs.com/CheckCode.aspx", True
　　xmlHttp.setRequestHeader "Accept", "*/*"
　　xmlHttp.setRequestHeader "Referer", "http://www.pceggs.com/Login.aspx"
　　xmlHttp.setRequestHeader "Accept-Language", "zh-cn"
　　xmlHttp.setRequestHeader "Accept-Encoding", "gzip, deflate"
　　xmlHttp.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; InfoPath.1; .NET CLR 2.0.50727)"
　　xmlHttp.setRequestHeader "Host", "www.pceggs.com"
　　xmlHttp.setRequestHeader "Connection", "Keep-Alive"
　　xmlHttp.send
　　While xmlHttp.ReadyState  4
　　DoEvents
　　Wend
　　Pic = xmlHttp.responseBody
　　With PicData
　　.Type = 1
　　.open
　　.write Pic
　　.SaveToFile App.Path & "\CheckCode.jpg", 2
　　.Cancel
　　.Close
　　End With
　　Set PicData = Nothing
　　Set xmlHttp = Nothing
　　frmLogin.ImgYZM.Picture = LoadPicture(App.Path & "\CheckCode.jpg")
　　End Function
　　方法二：
　　Private Sub Command1_Click()
　　WebBrowser1.Navigate2 "http://www.pceggs.com/login.aspx"
　　End Sub
　　Private Sub Command2_Click()
　　Dim CtrlRange, x
　　For Each x In WebBrowser1.Document.All
　　If UCase(x.tagName) = "IMG" Then
　　If InStr(x.src, "CheckCode.aspx") > 0 Then
　　Set CtrlRange = WebBrowser1.Document.body.createControlRange()
　　CtrlRange.Add (x)
　　CtrlRange.execCommand ("Copy")
　　Debug.Print "Copy"
　　Image1.Picture = Clipboard.GetData
　　End If
　　End If
　　Next
　　End Sub
　　-------------------------------------------------------------------------------------------------
　　Private Sub Form_Load()
　　WebBrowser1.Navigate "http://passport.baidu.com/?reg"
　　End Sub
　　Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
　　On Error Resume Next
　　WebBrowser1.Silent = True
　　Me.MousePointer = vbDefault
　　Dim x, CtrlRange
　　Dim sPath As String
　　sPath = App.Path
　　sPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
　　If Len(sPath) > 3 Then sPath = sPath & "\"
　　If Trim(txtUser.Text)  "" Then
　　gstrFileName = sPath & Trim(txtUser.Text) & "Code.bmp"
　　Else
　　gstrFileName = sPath & "TempCode.bmp"
　　End If
　　For Each x In WebBrowser1.Document.All
　　If x.tagName = "IMG" Then
　　If x.src = "http://passport.baidu.com/?verifypic" Then '这里就是那个动态图片的连接了
　　WebBrowser1.Stop
　　Set CtrlRange = WebBrowser1.Document.body.createControlRange()
　　CtrlRange.Add (x)
　　CtrlRange.execCommand ("Copy")
　　'MsgBox UCase$(x.src)
　　SavePicture Clipboard.GetData, gstrFileName
　　'SavePicture Clipboard.GetData, App.Path & "\1.bmp"    '用于把图片保存至硬盘中
　　Picture1.Picture = Clipboard.GetData
　　End If
　　End If
　　Next
　　End Sub
　　From: http://hi.baidu.com/372748472/blog/item/a166c9229dff92449258078e.html