识别验证码 vbs

Option Explicit

'要识别的图片名称
Dim picName
picName = "1.bmp"

'数字对照表，识别图片时就是把从图片提取的与该数组比较，相同的便是该数字
Dim NumAry(9)
NumAry(0)="00011000001111000110011011000011110000111100001111000011011001100011110000011000"
NumAry(1)="00011000001110000111100000011000000110000001100000011000000110000001100001111110"
NumAry(2)="00111100011001101100001100000011000001100000110000011000001100000110000011111111"
NumAry(3)="01111100110001100000001100000110000111000000011000000011000000111100011001111100"
NumAry(4)="00000110000011100001111000110110011001101100011011111111000001100000011000000110"
NumAry(5)="11111110110000001100000011011100111001100000001100000011110000110110011000111100"
NumAry(6)="00111100011001101100001011000000110111001110011011000011110000110110011000111100"
NumAry(7)="11111111000000110000001100000110000011000001100000110000011000001100000011000000"
NumAry(8)="00111100011001101100001101100110001111000110011011000011110000110110011000111100"
NumAry(9)="00111100011001101100001111000011011001110011101100000011010000110110011000111100"

Dim st,dataOff,imgW,imgH,imgWBytes,unitW,unitH
Set st = Wscript.createobject("ADODB.Stream")
st.Type = 1
st.Mode = 3
st.open()
'加载图片二进制流，并读取图片头信息
st.LoadFromFile(picName)
st.position = 10
'获取数据偏移
dataOff = BinVal(st.read(4))
st.read(4)
'图片宽、高（象素）
imgW = BinVal(st.read(4))
imgH = BinVal(st.read(4))
imgWBytes = imgW
'每个数字的宽、高（象素）
unitW = 8
unitH = 10

Dim i,ii,tmp,validCode
'循环获取五个数字
For i=0 To 4
 '获取某数字的特征，并与对照表进行比较，找到对应的则记录，否则以*号标识
 '3188是第一个数字的左上角的数据偏移，每向后一个则偏移增加 unitW+1
 tmp = getBound(3188+(unitW+1)*i)
 For ii=0 To 9
  If tmp = NumAry(ii) Then
   validCode = validCode & ii
   Exit For
  End If
 Next
 If Len(validCode) = i Then validCode = validCode & "*"
Next

'关闭
st.Close()
Set st = Nothing

'程序完成
MsgBox("验证码是："&validCode)

'----------

'获取指定矩形区域的特征码
'bp:矩形左上角的偏移 unitW:矩形宽 unitH:矩形高
'按照矩形图形从左到右、从上到下的方向进行提取，如该点二进制为1则表示为1，否则为0
Function getBound(bp)
 Dim str,i,ii
 st.Position = bp
 For i=1 To unitH
  For ii=1 To unitW
   If AscB(st.Read(1)) = 1 Then
    str = str & "1"
   Else
    str = str & "0"
   End If
  Next
  st.Position = bp - i*imgWBytes
 Next
 getBound = str
End Function

'将2进制转化为数字
Function BinVal(bin)
 dim ret
 ret = 0
 for i = lenb(bin) to 1 step -1
  ret = ret *256 + ascb(midb(bin,i,1))
 next
 BinVal=ret
End Function

Rem 将字符转换成2进制数组的函数
' ASCIIToByteArray converts ASCII strings to a byte array
' a byte array is different from an array of bytes, some things require
' a byte array, such as writing to the ADODB stream. This function
' utilises the ADODB ability to convert to byte arrays from dual digit HEX strings...
function ASCIIToByteArray(sText)
 Dim objRS
 Dim lTemp
 Dim sTemp

 sTemp = ""

 ' Convert the string to dual digit zero padded hex,
 ' there ain't no quick way of doing this... Would be interested to hear
 ' if anyone do this quicker...
 For lTemp = 1 to LenB(sText)
  sTemp = sTemp & Right("00" & Hex(AscB(MidB(sText,lTemp,1))),2)
 Next

 ' Ok, this may look a little weird, but trust me, this works...
 ' Open us a recordset
 set objRS = WScript.CreateObject("ADODB.Recordset")

 ' Add a fields to the current recordset, add the hex string
 objRS.Fields.Append "Temp",204,LenB(sText)+1
 objRS.Open
 objRS.AddNew
 objRS("Temp") = sTemp ' ADODB will convert here
 objRS.Update
 objRS.MoveFirst

 ASCIIToByteArray = objRS("Temp") ' A variant byte array is returned

 objRS.Close

 set objRS = Nothing
end function