php验证码源代码不带干扰线,分享之第二弹 验证码识别\去干扰线 源码及思路...

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

xmlHttp.Open "POST", strURL, False

xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary

xmlHttp.setRequestHeader "Content-Length", objTemp.size

xmlHttp.setRequestHeader "Host", "lab.ocrking.com"

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(@)ocrking.com 获取

//可能会有延迟，请匆重复发送

//授权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","http://user.56.com/api/get_auth.php?t=56_reg&rnd=0.5675823935307562")

Call AddForm("apiKey",key)

Call AddFile("ocrfile", "", "image/jpg", 路径)

ccc = Upload("http://lab.ocrking.com/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,"","